0010  // Et lille terminalprogram
0020
0030 USE DEVICES
0040 USE MESSAGES
0050 USE SYSTEM
0060 USE WINDOWS
0070
0080 POINTER term'window@ TO window@
0090 POINTER term'rd'req@ TO iostdreq@, term'wr'req@ TO iostdreq@
0100 seropen'err:=true; conopen'err:=true
0110
0120 RECORD ioextser@ // Serial device messages
0130   FIELD ioser@ OF iostdreq@ // Standard IO-request
0140   FIELD io_ctlchar#
0150   FIELD io_rbuflen# // Læse-bufferens længde
0160   FIELD io_extflags# // Bruges ikke
0170   FIELD io_baud# // Baud rate
0180   FIELD io_brktime# // Break-tid i mikro-sek
0190   FIELD io_termarray!(8) // Terminerings-tegn
0200   FIELD io_readlen! // Bits pr. læst tegn
0210   FIELD io_writelen! // Bits pr. skrevet tegn
0220   FIELD io_stopbits! // Antal stopbits
0230   FIELD io_serflags! // Serial flags
0240   FIELD io_status% // Serial port status
0250 ENDRECORD ioextser@
0260
0270  // Lav pointer til denne message
0280 POINTER ser'rd'req@ TO ioextser@, ser'wr'req@ TO ioextser@
0290
0300  // Opret datafelt (er automatisk på hele langordsadresser!)
0310 allocate(ser'rd'req@,1)
0320 allocate(ser'wr'req@,1)
0330
0340  // Opret læse- og skrive-porte
0350 POINTER ser'rd'port@ TO msgport@, ser'wr'port@ TO msgport@
0360 ^ser'rd'port@:=createport("TerminalInput",0)
0370 ^ser'wr'port@:=createport("TerminalOutput",0)
0380 IF ^ser'rd'port@=0 OR ^ser'wr'port@=0 THEN
0390   afslut
0400   PRINT "Svarporte kunne ikke oprettes"
0410   STOP
0420 ENDIF
0430
0440  // Hent de tilknyttede signalbits
0450 ser'rd'mask#:=2^ser'rd'port@.mp_sigbit!
0460 ser'wr'mask#:=2^ser'wr'port@.mp_sigbit!
0470
0480  // Åben den serielle enhed (serial.device)
0490 sername$:="serial.device"
0500 seropen'err:=pckopendevice(^sername$+4,0,^ser'rd'req@,0)
0510 IF seropen'err THEN
0520   afslut
0530   PRINT "Serielle enhed kunne ikke åbnes"
0540   PRINT "Fejl nr.: ",seropen'err
0550   STOP
0560 ENDIF
0570 ser'wr'req@:=ser'rd'req@ // Kopier standardværdier
0580 ^ser'rd'req@.ioser@.mn_replyport@:=^ser'rd'port@
0590 ^ser'wr'req@.ioser@.mn_replyport@:=^ser'wr'port@
0600  // Lav databuffere
0610 ser'ch%:=0; con'ch%:=0
0620  // .. og klargør de to serielle messages
0630 ser'rd'req@.ioser@.io_data#:=^ser'ch%
0640 ser'rd'req@.ioser@.io_length#:=1
0650 ser'rd'req@.ioser@.io_command%:=cmd_read%
0660 ser'wr'req@.ioser@.io_data#:=^con'ch%
0670 ser'wr'req@.ioser@.io_length#:=1
0680 ser'wr'req@.ioser@.io_command%:=cmd_write%
0690
0700  // Nu skal terminalvinduet åbnes
0710 WAIT 0.25
0720 term'name$:="Terminal"
0730 open'window(term'window@,term'name$)
0735 IF ^term'window@=0 THEN
0736   afslut
0737   PRINT "Vinduet kunne ikke åbnes"
0738   STOP
0739 ENDIF
0740 close'mask#:=2^term'window@.userport@.mp_sigbit!
0750
0760  // Opret read/write-porte til vinduet
0770 POINTER term'rd'port@ TO msgport@, term'wr'port@ TO msgport@
0780 ^term'rd'port@:=createport("TerminalRead",0)
0790 ^term'wr'port@:=createport("TerminalWrite",0)
0800 IF ^term'rd'port@=0 OR ^term'wr'port@=0 THEN
0810   afslut
0820   PRINT "Terminalporte kunne ikke oprettes"
0830   STOP
0840 ENDIF
0850 term'rd'mask#:=2^term'rd'port@.mp_sigbit!
0860
0870  // Opret messages
0880 ^term'rd'req@:=createstdio(^term'rd'port@)
0890 ^term'wr'req@:=createstdio(^term'wr'port@)
0900
0910  // Åben console-device
0920 term'rd'req@.io_data#:=^term'window@
0930 term'rd'req@.io_length#:=varsize(term'window@)
0940 con'name$:="console.device"
0950 conopen'err:=pckopendevice(^con'name$+4,0,^term'rd'req@,0)<>0
0960 IF conopen'err THEN
0970   afslut
0980   PRINT "console.device kunne ikke åbnes"
0990   STOP
1000 ENDIF
1010 term'wr'req@.io_device#:=term'rd'req@.io_device#
1020 term'wr'req@.io_unit#:=term'rd'req@.io_unit#
1030
1040  // Gør klar til brug
1050 term'rd'req@.io_data#:=^con'ch%
1060 term'rd'req@.io_length#:=1
1070 term'rd'req@.io_command%:=cmd_read%
1080 term'wr'req@.io_data#:=^ser'ch%
1090 term'wr'req@.io_length#:=1
1100 term'wr'req@.io_command%:=cmd_write%
1110
1120  // Så starter vi
1130 pcksendio(^term'rd'req@) // Hent tegn fra tastatur
1140 pcksendio(^ser'rd'req@) // .. og fra serieport
1150 term'rd'busy:=true; ser'rd'busy:=true
1160 ser'wr'busy:=false
1170 sig'mask#:=ser'rd'mask#+ser'wr'mask#+term'rd'mask#+close'mask#
1180 LOOP
1190   reciev'mask#:=comalwait(sig'mask#) BITAND sig'mask#
1200   WHILE reciev'mask# DO
1210     CASE true OF
1220     WHEN (reciev'mask# BITAND ser'rd'mask#)<>0
1230       dummy:=pckgetmsg(^ser'rd'port@)
1240       term'wr'req@.io_data#:=^ser'ch%
1250       term'wr'req@.io_length#:=1
1260       pcksendio(^ser'rd'req@)
1270       dummy:=pckdoio(^term'wr'req@)
1280       reciev'mask#:=reciev'mask# BITXOR ser'rd'mask#
1290     WHEN (reciev'mask# BITAND term'rd'mask#)<>0
1300       dummy:=pckgetmsg(^term'rd'port@)
1310       term'rd'busy:=false
1320       pcksendio(^ser'wr'req@)
1330       ser'wr'busy:=true
1340       reciev'mask#:=reciev'mask# BITXOR term'rd'mask#
1350     WHEN (reciev'mask# BITAND ser'wr'mask#)<>0
1360       dummy:=pckgetmsg(^ser'wr'port@)
1370       ser'wr'busy:=false
1380       pcksendio(^term'rd'req@)
1390       ter'rd'busy:=true
1400       reciev'mask#:=reciev'mask# BITXOR ser'wr'mask#
1410     WHEN (reciev'mask# BITAND close'mask#)<>0
1420       IF ser'rd'busy THEN
1430         pckabortio(^ser'rd'req@)
1440         dummy:=pckgetmsg(^ser'rd'port@)
1450       ENDIF
1460       IF term'rd'busy THEN
1470         pckabortio(^term'rd'req@)
1480         dummy:=pckgetmsg(^term'rd'port@)
1490       ENDIF
1500       IF ser'wr'busy THEN
1510         pckabortio(^ser'wr'req@)
1520         dummy:=pckgetmsg(^ser'wr'port@)
1530       ENDIF
1540       afslut
1550       END
1560     OTHERWISE
1570        // Det skulle ikke ske
1580     ENDCASE
1590   ENDWHILE
1600 ENDLOOP
1610
1620
1630 PROC open'window(REF windowptr@,REF name$) CLOSED
1640   POINTER mynewwindow@ TO newwindow@
1650   allocate(mynewwindow@)
1660   mynewwindow@:=newwindow@
1670   mynewwindow@.leftedge%:=0
1680   mynewwindow@.topedge%:=10
1690   mynewwindow@.type%:=comalstruct@.exec_io@.screentype%
1700   mynewwindow@.screen#:=comalstruct@.exec_io@.screen#
1710   mynewwindow@.width%:=640
1720   mynewwindow@.height%:=213
1730   mynewwindow@.flags#:=windowdrag#+windowclose#+windowdepth#+activate#
1740   mynewwindow@.title#:=^name$+4
1750   mynewwindow@.idcmpflags#:=$200 // windowclose
1760   ^windowptr@:=openwindow(^mynewwindow@)
1770   deallocate(mynewwindow@)
1780 ENDPROC open'window
1790
1800 PROC afslut
1810   IF NOT seropen'err THEN pckclosedevice(^ser'rd'req@)
1820   deallocate(ser'rd'req@)
1830   deallocate(ser'wr'req@)
1840   IF NOT conopen'err THEN pckclosedevice(^term'rd'req@)
1850   deletestdio(^term'wr'req@)
1860   deletestdio(^term'rd'req@)
1870   IF ^term'window@<>0 THEN closewindow(^term'window@)
1880   deleteallports
1890 ENDPROC afslut
