home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 149.lha / ColorTerm / main.4th < prev    next >
Text File  |  1988-04-25  |  2KB  |  81 lines
  1. \ This file Copyright 1988 by Warren Block.
  2.  
  3. \ main.f
  4.  
  5. \ To compile the whole program, just include this file.  Depending on
  6. \ your snapshot, you may also need exec/execsupport.f and devices/serial.f.
  7.  
  8. DECIMAL
  9.  
  10. FORTH DEFINITIONS
  11. ANew ColorTerminal
  12.  
  13. include serialwords.f
  14. include video.f
  15. include about.f
  16. include keyconvert.f
  17. include menustuff.f
  18. include intuievents.f
  19.  
  20. : ExecWait   ( signals --- signals )  \ Wait for a set of signals.
  21.    !D0 EXEC@ 53 ;
  22.  
  23. : Initialize   ( --- )  \ Set up everything.
  24.    GetFonts
  25.    SetVideo
  26.    SetUpMenus
  27.    Greetings
  28.    OpenSerialPort
  29.    TRUE TO Continue? ;
  30.  
  31. : CloseDown   ( --- )
  32.    CloseSerialPort
  33.    CurrentWindow @ ClearMenuStrip
  34.    CurrentWindow @ ?DUP IF  CloseWindow  THEN
  35.    CurrentScreen @ ?DUP IF  CloseScreen  THEN
  36.    FreeSpareBitMap
  37.    FreeMenuMemory
  38.    CloseFonts
  39.    ?Turnkey IF Bye THEN ;
  40.  
  41. : GetSerChar   ( --- )  \ Something has arrived at the serial port--get it.
  42.    0 LOCALS| actual |
  43.    ReadMessage @ WaitIO  DROP  \ wait for I/O to finish
  44.    ReadBuffer C@               \ get the character
  45.    PrintScrChar                \ print it
  46.    SDCMD_QUERY ReadMessage @ +ioCommand W!
  47.    ReadMessage @ BeginIO
  48.    ReadMessage @ WaitIO  DROP
  49.    CMD_READ    ReadMessage @ +ioCommand W!
  50.    ReadMessage @ +ioActual @ TO actual
  51.    actual IF
  52.      actual ReadMessage @ +ioLength !
  53.      ReadMessage @ BeginIO
  54.      ReadMessage @ WaitIO  DROP
  55.      1      ReadMessage @ +ioLength !
  56.      ReadBuffer actual + ReadBuffer DO
  57.        IC@ PrintScrChar
  58.      LOOP
  59.    THEN
  60.    ReadMessage @ BeginIO ;     \ ask for the next
  61.  
  62. : ColorTerm   ( --- )  \ Main activation word.
  63.    0 0 0 LOCALS| serbit intuibit wakebits |
  64.    Initialize
  65.    BEGIN
  66.      Continue?
  67.    WHILE
  68.      ToggleCursor
  69.      1 ReadMessage @ +ioMessage +mnReplyPort @ +mpSigBit C@ SCALE TO serbit
  70.      1 CurrentWindow @          +wdUserPort  @ +mpSigBit C@ SCALE TO intuibit
  71.      serbit intuibit | ExecWait  TO wakebits      \ wait for an event
  72.      ToggleCursor
  73.      ReadMessage @ CheckIO IF
  74.        GetSerChar
  75.      THEN
  76.      wakebits intuibit AND IF
  77.        HandleEvents
  78.      THEN
  79.    REPEAT
  80.    CloseDown ;
  81.