326 lines
8.5 KiB
Modula-2
326 lines
8.5 KiB
Modula-2
|
|
: mod:vortrag ;
|
|
|
|
24 constant rows
|
|
64 constant cols
|
|
|
|
wvariable lcol 7 lcol W!
|
|
|
|
ifnot: adm:fkt!s!b@ \ ( s fkt -- b )
|
|
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
|
|
ifnot: adm:fkt!b!b@ \ ( b fkt -- b )
|
|
: adm:fkt!b!b@ b[ [a!] [a!] [a@] ]b ;
|
|
ifnot: adm:fkt!b@ \ ( fkt -- b )
|
|
: adm:fkt!b@ b[ [a!] [a@] ]b ;
|
|
|
|
ifnot: bel:char \ ( b -- )
|
|
: bel:char b[ [b!] ]b ;
|
|
ifnot: bel:ctrl!b! \ ( b ctrl -- )
|
|
: bel:ctrl!b! b[ 0 [b!] 3 [b!] [b!] [b!] ]b ;
|
|
ifnot: bel:fkt!b!b! \ ( b b fkt -- )
|
|
: bel:fkt!b!b! b[ 0 [b!] [b!] [b!] [b!] ]b ;
|
|
|
|
ifnot: scr:bs \ ( -- ) - backspace
|
|
: scr:bs 08 bel:char ;
|
|
ifnot: scr:tab \ ( -- ) - tabulator
|
|
: scr:tab 09 bel:char ;
|
|
ifnot: scr:pos1 \ ( -- ) - cursor an zeilenanfang
|
|
: scr:pos1 03 bel:char ;
|
|
ifnot: scr:setcol \ ( colnr -- ) - farbe wählen 0..15
|
|
: scr:setcol 06 bel:ctrl!b! ;
|
|
ifnot: scr:sline \ ( row -- ) - anfangszeile scrollbereich
|
|
: scr:sline 07 bel:ctrl!b! ;
|
|
ifnot: scr:setx \ ( x -- ) - cursor position x setzen
|
|
: scr:setx 02 bel:ctrl!b! ;
|
|
ifnot: scr:sety \ ( y -- ) - cursor position y setzen
|
|
: scr:sety 03 bel:ctrl!b! ;
|
|
ifnot: scr:curon \ ( -- ) - cursor anschalten
|
|
: scr:curon 04 bel:char ;
|
|
ifnot: scr:curoff \ ( -- ) - cursor abschalten
|
|
: scr:curoff 05 bel:char ;
|
|
ifnot: scr:logo \ ( y x -- ) - hive logo
|
|
: scr:logo 5 bel:fkt!b!b! ;
|
|
|
|
\ adm:setsound ( sfkt -- sstat ) - soundsystem verwalten
|
|
\ sfkt:
|
|
\ 0: hss-engine abschalten
|
|
\ 1: hss-engine anschalten
|
|
\ 2: dac-engine abschalten
|
|
\ 3: dac-engine anschalten
|
|
\ sstat - status/cognr startvorgang
|
|
ifnot: adm:setsound
|
|
: adm:setsound
|
|
5C adm:fkt!b!b@ ;
|
|
|
|
\ wav:start ( cstr -- err )
|
|
ifnot: wav:start
|
|
: wav:start
|
|
96 adm:fkt!s!b@ ;
|
|
|
|
\ wav:stop ( -- )
|
|
ifnot: wav:stop
|
|
: wav:stop
|
|
97 adm:fkt!b@ drop ;
|
|
|
|
\ won
|
|
ifnot: won
|
|
: won
|
|
0 adm:setsound 3 adm:setsound 2drop ;
|
|
|
|
\ woff
|
|
ifnot: woff
|
|
: woff
|
|
2 adm:setsound 1 adm:setsound 2drop ;
|
|
|
|
: lcol@ lcol W@ ; \ ( -- col )
|
|
|
|
: lines \ ( n -- )
|
|
0 do cr loop ;
|
|
|
|
: waitkey
|
|
scr:curoff cr key drop scr:bs scr:bs scr:bs scr:curon ;
|
|
|
|
: nextpage
|
|
scr:curoff scr:pos1 lcol@ spaces ." -->" key drop scr:bs scr:bs scr:bs scr:curon ;
|
|
|
|
: .head \ ( -- )
|
|
4 scr:setcol scr:pos1 lcol@ spaces ;
|
|
|
|
: .bullet \ ( -- )
|
|
0 scr:setcol scr:pos1 lcol@ spaces 0f emit space ;
|
|
|
|
: .number \ ( n -- n )
|
|
0 scr:setcol scr:pos1 lcol@ spaces dup . 1+
|
|
2e emit space ;
|
|
|
|
: .line \ ( -- )
|
|
cr 0 scr:setcol scr:pos1 lcol@ 2+ spaces ;
|
|
|
|
: .sub \ ( -- )
|
|
0 scr:setcol scr:pos1 lcol@ 2+ spaces ;
|
|
|
|
wvariable xpos 1 xpos W!
|
|
wvariable ypos 1 ypos W!
|
|
|
|
: pos! \ ( x y -- )
|
|
ypos W! xpos W! ;
|
|
|
|
: pos@ \ ( -- x y )
|
|
xpos W@ ypos W@ ;
|
|
|
|
: nextline
|
|
ypos W@ 1+ ypos W! ;
|
|
|
|
: move \ ( x y -- )
|
|
1 delms pos@ scr:sety scr:setx ;
|
|
|
|
|
|
: btop0 \ ( -- )
|
|
move 9f emit 6 0 do 90 emit loop 9e emit nextline ;
|
|
|
|
: bbot0 \ ( -- )
|
|
move 9d emit 6 0 do 90 emit loop 9c emit nextline ;
|
|
|
|
: btop1 \ ( -- )
|
|
move 2 spaces 9f emit 6 0 do 90 emit loop 9e emit nextline ;
|
|
|
|
: bbot1 \ ( -- )
|
|
move 2 spaces 9d emit 6 0 do 90 emit loop 9c emit nextline ;
|
|
|
|
: bmid0 \ ( -- )
|
|
move 91 emit ." COG " 95 emit 90 emit bb emit nextline
|
|
move 91 emit ." " 95 emit 90 emit aa emit nextline ;
|
|
|
|
: bmid1 \ ( -- )
|
|
move a9 emit 90 emit 94 emit ." COG " 91 emit nextline
|
|
move ba emit 90 emit 94 emit ." " 91 emit nextline ;
|
|
|
|
: bmid2 \ ( -- )
|
|
move a9 emit 90 emit 94 emit ." SER "
|
|
95 emit 90 emit bb emit ." [TERMINAL]" nextline
|
|
move ba emit 90 emit 94 emit ." " 91 emit nextline ;
|
|
|
|
: bmid3 \ ( -- )
|
|
move a9 emit 90 emit 94 emit ." VGA "
|
|
95 emit 90 emit bb emit ." [BELLATRIX]" nextline
|
|
move ba emit 90 emit 94 emit ." KBD " 91 emit nextline ;
|
|
|
|
: bmid4 \ ( -- )
|
|
move 91 emit ." COG " 95 emit 90 emit bb emit
|
|
." Zeichenausgabekanal (emit)" nextline
|
|
move 91 emit ." " 95 emit 90 emit aa emit
|
|
." Zeicheneingabekanal (key)" nextline ;
|
|
|
|
: cog0 \ ( x y -- )
|
|
0 scr:setcol pos! btop0 bmid0 bbot0 ;
|
|
|
|
: cog1 \ ( x y -- )
|
|
0 scr:setcol pos! btop1 bmid1 bbot1 ;
|
|
|
|
: cog3 \ ( x y -- )
|
|
0 scr:setcol pos! btop0 bmid4 bbot0 ;
|
|
|
|
: cogext \ ( x y -- )
|
|
0 scr:setcol pos! btop1 bmid2 bbot1 ;
|
|
|
|
: cogint \ ( x y -- )
|
|
0 scr:setcol pos! btop1 bmid3 bbot1 ;
|
|
|
|
: drvser
|
|
0 scr:setcol 2dup cog0 swap a + swap cogext ;
|
|
|
|
: drvint
|
|
0 scr:setcol 2dup cog0 swap a + swap cogint ;
|
|
|
|
: p0
|
|
0 scr:sline cls 5 lines
|
|
14 1c scr:curoff scr:logo won c" woodz.wav" wav:start drop
|
|
key drop scr:curon wav:stop woff ;
|
|
|
|
: i1
|
|
0 scr:sline cls 3 lines
|
|
.head ." Implementierungsvarianten" cr waitkey
|
|
.bullet ." Forth-Diamond: Master & Slaves = PropForth" waitkey cr
|
|
.sub ." Nachteil: Programmierung aller Treiber in Forth" waitkey cr
|
|
.bullet ." Forth-Spin: Forth mit SPIN-Interface" waitkey cr
|
|
.sub ." Vorteil: Nutzung fertiger Treiber" waitkey
|
|
.sub ." Nachteil: hoher Ressourcenverbrauch" waitkey cr
|
|
.bullet ." Forth-Funktionskomplexe: " cr cr
|
|
.sub ." Master = Forth" cr
|
|
.sub ." Slaves = Spin-Funktionsbibliotheken" cr
|
|
.sub ." Interface Forth <--> Spin = 8Bit-Bus" cr cr
|
|
nextpage ;
|
|
|
|
: i2
|
|
0 scr:sline cls 3 lines
|
|
.head ." Implementierungsvarianten" cr cr
|
|
.bullet ." Forth-Funktionskomplexe: " cr cr
|
|
.sub ." Master = Forth" cr
|
|
.sub ." Slaves = Spin-Funktionsbibliotheken" cr
|
|
.sub ." Interface Forth <--> Spin = 8Bit-Bus" cr waitkey
|
|
.bullet ." Nachteile:" cr cr
|
|
.sub ." Spin --> Compiler noch auf Host" cr waitkey
|
|
.bullet ." Vorteile:" cr cr
|
|
.sub ." Code ist schon vorhanden (TriOS)" waitkey
|
|
.sub ." Gegenseitige Befruchtung von Forth & TriOS" waitkey
|
|
.sub ." Maximale Ressourcen für Forth im Master" waitkey
|
|
.sub ." Spin-Code kann später auch durch Forth ersetzt werden" cr
|
|
nextpage ;
|
|
|
|
: i3
|
|
0 scr:sline cls 3 lines
|
|
.head ." Ablauf der Implementierung" cr waitkey
|
|
.bullet ." Ausgangslage: " cr cr
|
|
.sub ." Forth mit Terminalzugriff" cr waitkey
|
|
.bullet ." Plan:" cr cr
|
|
.sub ." 1. Busroutine um auf Slaves zuzugreifen" waitkey
|
|
.sub ." 2. Integration VGA/Keyboard/SD-Card" waitkey
|
|
.sub ." 3. Autostart" cr cr
|
|
nextpage ;
|
|
|
|
|
|
: p1
|
|
0 scr:sline cls 1 lines
|
|
.head ." Buszugriff" cr cr
|
|
.bullet ." ! ( n adr -- ) store - Wert im RAM speichern" cr
|
|
.bullet ." @ ( adr -- n ) fetch - Wert aus RAM lesen" cr waitkey
|
|
.bullet ." c! c@ p! p@ - Abwandlungen der Grundform" cr waitkey
|
|
.bullet ." s! ( c adr -- ) - Byte an Slave senden" cr
|
|
.bullet ." s@ ( adr -- c ) - Byte von Slave empfangen" cr waitkey
|
|
.bullet ." b! ( c -- ) - Byte an Bellatrix senden" cr
|
|
.bullet ." b@ ( -- c ) - Byte von Bellatrix empfangen" cr
|
|
.bullet ." a! ( c -- ) - Byte an Administra senden" cr
|
|
.bullet ." a@ ( -- c ) - Byte von Administra empfangen" cr cr
|
|
.head ." Beispiele :" cr cr
|
|
.bullet ." 01 b! - Bildschirm löschen" waitkey
|
|
.bullet ." : cls 01 b! ; " waitkey
|
|
.bullet ." : bel:key 0 b! 2 b! b@ ; \ ( -- key )" cr
|
|
nextpage ;
|
|
|
|
: p2
|
|
0 scr:sline cls 5 lines
|
|
.head ." IO-Kanäle/Pipes" cr waitkey
|
|
9 8 cog3 key drop
|
|
9 c cog3
|
|
.line ." ..."
|
|
9 11 cog3
|
|
cr cr
|
|
nextpage ;
|
|
|
|
: p3
|
|
0 scr:sline cls 5 lines
|
|
.head ." Serieller Treiber" cr cr
|
|
9 8 drvser
|
|
9 c cog3
|
|
.line ." ..."
|
|
9 11 cog3
|
|
cr cr
|
|
nextpage ;
|
|
|
|
: p4
|
|
0 scr:sline cls 5 lines
|
|
.head ." VGA/Keyboard-Treiber" cr cr
|
|
9 8 drvser
|
|
9 c drvint
|
|
.line ." ..."
|
|
9 11 cog3
|
|
cr cr
|
|
nextpage ;
|
|
|
|
: p5
|
|
0 scr:sline cls 5 lines
|
|
.head ." Treiber: VGA" cr cr
|
|
9 8 drvint cr
|
|
.line ." : drv-vga "
|
|
.line ." begin"
|
|
.line ." key?"
|
|
.line ." if key b! then"
|
|
.line ." 0 until ;"
|
|
cr cr
|
|
nextpage ;
|
|
|
|
: p6
|
|
0 scr:sline cls 5 lines
|
|
.head ." Treiber: Keyboard" cr cr
|
|
9 8 drvint cr
|
|
.line ." : drv-key"
|
|
.line ." begin"
|
|
.line ." bel:keystat"
|
|
.line ." if bel:key emit then"
|
|
.line ." 0 until ;"
|
|
cr cr
|
|
nextpage ;
|
|
|
|
: p7
|
|
0 scr:sline cls 5 lines
|
|
.head ." Treiber: Gesamt" cr cr
|
|
9 8 drvint cr
|
|
.line ." : drv:int"
|
|
.line ." begin"
|
|
.line ." \ input --> vga/video"
|
|
.line ." 200 0 do key?"
|
|
.line ." if key b[ [b!] ]b then loop"
|
|
.line ." \ output <-- keyboard"
|
|
.line ." b[ [key?]"
|
|
.line ." if [key] [emit] then ]b"
|
|
.line ." 0 until ;"
|
|
cr cr
|
|
nextpage ;
|
|
|
|
: p8
|
|
0 scr:sline cls 5 lines
|
|
.head ." Semaphoren" cr waitkey
|
|
.bullet ." : bel:key 0 b! 2 b! b@ ; \ ( -- key )" cr waitkey
|
|
.bullet ." : bel:key bon 0 b! 2 b! b@ boff ;" cr waitkey
|
|
.bullet ." [ ... ]" cr waitkey
|
|
.bullet ." b[ ... ]b" cr waitkey
|
|
.bullet ." : bel:key b[ 0 b! 2 b! b@ ]b ;" cr waitkey
|
|
.bullet ." : bel:key b[ 0 [b!] 2 [b!] [b@] ]b ;" cr waitkey
|
|
.bullet ." : bel:key 2 0 b[ [b!] [b!] [b@] ]b ;" cr cr
|
|
cr cr
|
|
nextpage ;
|
|
|
|
: run
|
|
begin p0 i1 i2 i3 p1 p2 p3 p4 p5 p6 p7 p8 0 until ;
|
|
|