' Speedwriter II
'
' Written by Richard Karsmakers
' Original idea and code by Frank Lemmen and Richard Karsmakers
' Works on all ST systems with monochrome monitor
'
' Last-minute stuff by Stefan Posthuma:
' Abort option in pause mode
' Turn off cursor at program exit
'
If Xbios(4)<>2       !No high res?
  Alert 1,"This program only runs|in high resolution!!",1,"OK",Dummy%
  Edit
Endif
Mem%=Fre(0)          !Establish free memory
If Mem%<120000       !Memory left; is it enough?
  Alert 1,"This program cannot|run: You don't have|enough memory!!",1," OK ",Dummy%
Endif
Len%=0               !Length of file
Res%=(Mem%-100000)/4 !This is the space reserved for the text, divided by 4
Dim Text%(Res%)      !Dim memory
@About
'
' The 'Do-Loop' is the whole program
'
@Con                         !Cursor on
@Rof                         !Reverse off
Cols%=Peek(&HFF8240)         !Buffer screen color for exit
Spoke &HFF8240,1
Do
  Start:
  @Buffemp
  X%=Inp(2)                  !Get key
  If X%=8 Or X%=13
    Goto Jump
  Endif
  If X%<32
    Goto Start
  Endif
  If X%<127 Or X%=255
    Goto Less
  Endif
  If X%>186 And X%<193       !Function keys
    X%=X%-186
    Effe%=X%
    On X% Gosub Ron,Rof,Togcol,Disk,Session,About
    If Effe%=4 And Laadflag!=True
      Laadflag!=False
      @Rof
      Spoke &HFF8240,1
      Cls
      Goto Start
    Endif
    If Effe%>3
      Goto Start
    Endif
    Goto Further
  Endif
  If X%=196                  !F10 (Quit)
    @Buffcursor
    @Quit
    @Setcursor
    Goto Start
  Endif
  If X%=225                  !Undo (Kill Session)
    @Buffcursor
    @Kill
    Goto Start
  Endif
  If X%=226                  !Help
    @Buffcursor
    @Help
    @Setcursor
    Goto Start
  Endif
  If X%=199                  !Clr Home (Clear Screen)
    Cls
    Goto Further
  Endif
  If X%=210                  !Insert (Insert line)
    Print Chr$(27);"L";
    Goto Further
  Endif
  If X%=127                  !Delete (Delete line)
    Print Chr$(27);"l";
    Goto Further
  Endif
  Jump:
  If X%=13                   !Return pressed
    Print Chr$(X%)           !Print return
    Goto Further
  Endif
  If X%=8                    !Backspace pressed
    If Crscol=1 And Crslin=1 !Cursor in home position
      Goto Further
    Endif
    If Crscol=1              !On leftmost column, but not on first line
      Buf%=Crslin
      Buf%=Buf%-1
      Print Chr$(27);"Y";Chr$(31+Buf%);Chr$(31+80);
      Print " ";
      Print Chr$(27);"Y";Chr$(31+Buf%);Chr$(31+80);
    Else                    !Regular backspace
      Print Chr$(27);"D";
      Print " ";
      Print Chr$(27);"D";
    Endif
    Goto Further
  Endif
  If X%=205                 !Cursor right
    If Crscol=80
      Print Chr$(13)
    Else
      Print Chr$(27);"C";
    Endif
    Goto Further
  Endif
  If X%=203                 !Cursor left
    If Crscol=1 And Crslin=1
      Goto Further
    Endif
    If Crscol=1
      Buf%=Crslin
      Buf%=Buf%-1
      Print Chr$(27);"Y";Chr$(31+Buf%);Chr$(31+80);
    Else
      Print Chr$(27);"D";
    Endif
    Goto Further
  Endif
  If X%=208                 !Cursor down
    If Crslin=25
      Buf%=Crscol
      Print
      Print Chr$(13);
      Print Chr$(27);"Y";Chr$(31+25);Chr$(31+Buf%);
    Else
      Print Chr$(27);"B";
    Endif
    Goto Further
  Endif
  If X%=200                 !Cursor up
    Print Chr$(27);"A";
    Goto Further
  Endif
  Goto Start
  Less:
  Print Chr$(X%);
  Further:
  Poke Varptr(Text%(0))+Len%,(X% Xor 255)
  Inc Len%
Loop
'
Procedure Session               !This routine runs the session
  Local Buf%,Dummy%,Cols%
  If Len%=0                     !No session yet loaded/made
    @Alert("ERROR: NO SESSION!","OK",1,*Dummy%)
    Goto Get_out
  Endif
  Print Chr$(27);"H";           !Cursor home
  @Rof                          !Reverse off
  Cols%=Peek(&HFF8240)          !Temporarily buffer colors
  Spoke &HFF8240,1
  Cls
  X%=0
  Do
    @Buffemp
    Buf%=Peek(Varptr(Text%(0))+X%) Xor 255
    Sound 1,0,59,5,1
    If Buf%=8                    !Backspace
      If Crscol=1 And Crslin=1
        Goto Skipper
      Endif
      If Crscol=1
        Buf%=Crslin
        Buf%=Buf%-1
        Print Chr$(27);"Y";Chr$(31+Buf%);Chr$(31+80);
        Print " ";
        Print Chr$(27);"Y";Chr$(31+Buf%);Chr$(31+80);
      Else
        Print Chr$(27);"D";
        Print " ";
        Print Chr$(27);"D";
      Endif
      Goto Skipper
    Endif
    If Buf%=200                 !Cursor up
      Print Chr$(27);"A";
      Goto Skipper
    Endif
    If Buf%=208                 !Cursor down
      If Crslin=25
        Buf%=Crscol
        Print
        Print Chr$(13);
        Print Chr$(27);"Y";Chr$(31+25);Chr$(31+Buf%);
      Else
        Print Chr$(27);"B";
      Endif
      Goto Skipper
    Endif
    If Buf%=203                 !Cursor left
      If Crscol=1 And Crslin=1
        Goto Skipper
      Endif
      If Crscol=1
        Buf%=Crslin
        Buf%=Buf%-1
        Print Chr$(27);"Y";Chr$(31+Buf%);Chr$(31+80);
      Else
        Print Chr$(27);"D";
      Endif
      Goto Skipper
    Endif
    If Buf%=205                 !Cursor right
      If Crscol=80
        Print Chr$(13)
      Else
        Print Chr$(27);"C";
      Endif
      Goto Skipper
    Endif
    If Buf%=13                  !Return
      Print Chr$(13)
      Goto Skipper
    Endif
    If Buf%=199                 !Clr Home (Clear Screen)
      Print Chr$(27);"E";
      Goto Skipper
    Endif
    If Buf%=127                 !Delete (Delete line)
      Print Chr$(27);"l";
      Goto Skipper
    Endif
    If Buf%=210                 !Insert (Insert line)
      Print Chr$(27);"L";
      Goto Skipper
    Endif
    If Buf%=1                   !F1 (Reverse On)
      @Ron
      Goto Skipper
    Endif
    If Buf%=2                   !F2 (Reverse Off)
      @Rof
      Goto Skipper
    Endif
    If Buf%=3                   !F3 (Toggle Screen Colors)
      @Togcol
      Pause 2
      Goto Skipper
    Endif
    Print Chr$(Buf%);
    Skipper:
    Sound 1,15,Buf%,5,1
    Sound 1,0,0,0,0
    If Inp?(2)
      Dummy%=Inp(2)
      If Dummy%=27         !Escape (Pause toggle key)
        Dummy%=0
        @Buffemp
        Pause 5
        Alert 1," PAUSE MODE ",1," CONT | ABORT ",D%
        If D%=2
          X%=Len%-1
        Endif
      Endif
    Endif
    Inc X%
    Exit If X%=Len%
  Loop
  '  If Laadflag!=False
  '  @Setcursor
  ' Endif
  Spoke &HFF8240,Cols%
  Get_out:
Return
'
Procedure Buffcursor
  Bufx%=Crscol
  Bufy%=Crslin
Return
'
Procedure Setcursor
  Print Chr$(27);"Y";Chr$(31+Bufy%);Chr$(31+Bufx%);
Return
'
Procedure Kill
  @Coff
  @Alert("KILL THIS SESSION||Are you sure? All data|will be fatally lost!","YES|NO",2,*Dummy%)
  If Dummy%=1
    Len%=0
    @Rof
    Spoke &HFF8240,1
    Cls
  Endif
  If Dummy%=2
    @Setcursor
  Endif
  @Con
Return
'
Procedure Coff
  Print Chr$(27);"f";
Return
'
Procedure Con
  Print Chr$(27);"e";
Return
'
Procedure Buffemp
  Lpoke Xbios(14,1)+6,0      !Clear keyboard buffer
Return
'
Procedure Alert(Tx$,But$,Op%,Rck%)
  ' This routine turns the mouse on and puts an alert box on the screen
  ' The old screen is put in Main$. When leaving this routine, Main$ is put
  ' back on the screen and the mouse is again hidden
  ' It is adapted from an "68000'er" source (1988)
  ' Parameters: Tx$  = Alert box string
  '             But$ = Buttons string
  '             Op%  = Default button
  '             Rck% = Return value
  @Coff
  Sget Main$
  Showm
  Local Hinten$,Hoch%,Breit%,X%,Y%,K%,F%,A%,B%,Xo%,Xu%,Yo%,T%,Qq%,Buf%
  Local Txtg%,X_res%,Y_res%,Yp%,Xp%
  Yp%=-1
  Xp%=-1
  @Getres
  Lpoke Xbios(14,1)+6,0      !Clear keyboard buffer
  Color 1
  Deftext ,0,0,Txtg%
  Deffill ,0,0
  Defline 1,1,2,2
  Graphmode 1
  Dim Txx$(10),Bxx$(8)       !Create text-and button arrays
  T%=0
  F%=0
  '
  ' Convert codes to spaces
  '
  While Instr(Tx$,"»")<>0
    Buf%=Instr(Tx$,"»")
    A%=Val(Mid$(Tx$,Buf%+1,2))
    If A%>9
      Tx$=Left$(Tx$,Buf%-1)+Space$(A%)+Right$(Tx$,Len(Tx$)-Buf%-2)
    Else
      Tx$=Left$(Tx$,Buf%-1)+Space$(A%)+Right$(Tx$,Len(Tx$)-Buf%-1)
    Endif
  Wend
  '
  While Tx$>"" And T%<10     !Analyse text information
    Inc T%
    A%=Instr(Tx$,"|")        !Split line
    If A%=0
      Txx$(T%)=Tx$
      Tx$=""
    Else
      Txx$(T%)=Left$(Tx$,A%-1)
      Tx$=Right$(Tx$,Len(Tx$)-A%)
    Endif
    F%=Max(F%,Len(Txx$(T%))) !Determine longest line
  Wend
  B%=0
  While But$>"" And B%<8     !Analyse button information
    Inc B%
    A%=Instr(But$,"|")       !Split lines
    If A%=0
      Bxx$(B%)="    "+But$
      But$=""
    Else
      Bxx$(B%)="    "+Left$(But$,A%-1)
      But$=Right$(But$,Len(But$)-A%)
    Endif
    F%=Max(F%,Len(Bxx$(B%))) !Determine longest line
  Wend
  Breit%=(F%+5)*8            !Width of alert box
  Hoch%=(B%+T%+4)*16/Y_res%  !Height of alert box
  If Xp%+Breit%>639 Or Xp%<0
    Xp%=(320/X_res%)-Breit%/2
  Endif
  If Yp%+Hoch%>399 Or Yp%<0
    Yp%=(200/Y_res%)-Hoch%/2
  Endif
  Get Xp%,Yp%,Xp%+Breit%,Yp%+Hoch%,Hinten$
  Pbox Xp%,Yp%,Xp%+Breit%,Yp%+Hoch%
  Box Xp%+2,Yp%+2,Xp%-2+Breit%,Yp%-2+Hoch%
  F%=1
  Do
    Text Xp%+20,Yp%+F%*16/Y_res%+20/Y_res%,Txx$(F%)
    Inc F%
    Exit If F%>T%
  Loop
  F%=1
  Do
    Qq$="F"+Str$(F%)
    Text Xp%+Breit%/2-Len(Bxx$(F%))*4-16,Yp%+T%*16/Y_res%+40/Y_res%+F%*16/Y_res%,Bxx$(F%)
    Text Xp%+15,Yp%+T%*16/Y_res%+40/Y_res%+F%*16/Y_res%,Qq$
    Inc F%
    Exit If F%>B%
  Loop
  If Op%>0 And Op%<=B%       !Invert default button if needed
    Deffill ,1,1
    Graphmode 3
    Pbox Xp%+10,Yp%+T%*16/Y_res%+27/Y_res%+Op%*16/Y_res%,Xp%+Breit%-10,Yp%+T%*16/Y_res%+43/Y_res%+Op%*16/Y_res%
    Graphmode 1
    Deffill ,0,0
  Endif
  F%=1
  Do
    Box Xp%+10,Yp%+T%*16/Y_res%+27/Y_res%+F%*16/Y_res%,Xp%+Breit%-10,Yp%+T%*16/Y_res%+43/Y_res%+F%*16/Y_res%
    Inc F%
    Exit If F%>B%
  Loop
  Xo%=Xp%+10                 !Determine mouse action range
  Yo%=Yp%+T%*16/Y_res%+43/Y_res%
  Xu%=Xp%+Breit%-10
  Yu%=Yp%+T%*16/Y_res%+43/Y_res%+B%*16/Y_res%
  Do                         !Wait for mouse fire button or function key
    Repeat
      Mouse X%,Y%,K%
    Until (K%=1 And X%>Xo% And X%<Xu% And Y%>Yo% And Y%<Yu%) Or Inp?(2)
    Qq$=Inkey$               !Check which key
    Exit If Qq$=Chr$(13) And Op%>0 And Op%<=B%  !Return? Leave!
    Exit If K%=1                                !Mousekey? Leave!
    '                                           !Allowed function key? Leave!
    Exit If Len(Qq$)=2 And Right$(Qq$,1)>=Chr$(&H3B) And Right$(Qq$,1)<=Chr$(&H3B+B%-1)
  Loop
  '
  ' Create variables that are given back to the program
  '
  If K%<>1
    If Len(Qq$)=2
      *Rck%=Asc(Right$(Qq$,1))-&H3A   !Function key
    Else
      *Rck%=Op%                       !Or default value
    Endif
  Else
    *Rck%=((Y%-Yo%) Div (16/Y_res%))+1         !Or mousepointer position
  Endif
  Put Xp%,Yp%,Hinten$                 !Put background back
  Erase Txx$()
  Erase Bxx$()
  Sput Main$
  Hidem
  @Con
Return
'
Procedure Fileselectmooi(A$)
  ' a$ = String containing the text
  Deffill 0,1
  Pbox 157,20,482,60
  Box 157,20,482,54
  Box 160,23,479,51
  Box 161,24,478,50
  Deffill 1,1
  Pbox 162,25,477,49
  Graphmode 3
  Deftext ,,,13
  Text 184,43,A$
  Graphmode 1
Return
'
Procedure Getres
  Local P%
  P%=Xbios(4)                         !Resolution (0/1/2)
  Txtg%=7*Int(Abs(P%-0.5))+6          !Text sizes (6/6/13)
  X_res%=Int(Abs(P%-1.5))+1           !X-direction factor (2/1/1)
  Y_res%=-1*Int(Abs(P%-0.5))+2       !Y-direction factor (2/2/1)
Return
'
Procedure Ron
  Print Chr$(27);"p";
Return
'
Procedure Rof
  Print Chr$(27);"q";
Return
'
Procedure Togcol
  Spoke &HFF8240,Peek(16745024) Xor 1
Return
'
Procedure Help
  @Coff
  Sget Main$
  Cls
  @Ron
  Print Space$(27);"SPEEDWRITER II HELP SCREEN";Space$(27)
  @Rof
  '
  Print Space$(17);"A Public Domain program by: Richard Karsmakers"
  Print
  Print String$(80,"-")
  Print "   F1         Reverse On                  Help        Help Screen"
  Print "   F2         Reverse Off                 Undo        Kill Current Session"
  Print "   F3         Toggle Screen Colors        Clr Home    Clear Screen"
  Print "   F4         Disk Operations             Delete      Delete Line"
  Print "   F5         Run Session                 Insert      Insert Line"
  Print "   F6         Info"
  Print "  F10         Quit                        Esc         Pause (Playback mode only)"
  Print String$(80,"-")
  Print " With 'Speedwriter II', it is possible to send original letters over to any of"
  Print "your friends who also have the program - a revolutionary means of communication!"
  Print Space$(31);"PROGRAM STATISTICS"
  Print
  Print Space$(23);"Total memory available: ";Mem%;" bytes"
  Print Space$(23);"Current session's size: ";Len%;" bytes"
  Print Space$(23);"Memory percentage used: ";Len%/(Mem%/100);"%"
  '
  @Buffemp
  Do
    Exit If Inp?(2) Or Mousek
  Loop
  If Inp?(2)
    Dummy%=Inp(2)
  Endif
  Sput Main$
  @Con
Return
'
Procedure Disk
  Local Dummy%,X%
  @Buffcursor
  Button$="  Load Speedwriter II (.SPW) File|  Save Speedwriter II (.SPW) File|  Delete|  Cancel"
  @Alert("  SPEEDWRITER II DISK OPERATION MENU||»7Please select one of the|»9following buttons...",Button$,0,*Dummy%)
  If Dummy%=1
    Address%=Varptr(Text%(0))
    @Loading
  Endif
  If Dummy%=2
    @Saving
  Endif
  If Dummy%=3
    Sget Maan$
    @Fileselectmooi("SELECT FILE TO DELETE")
    Fileselect "\*.*","",Lo$
    If Exist(Lo$)
      Kill Lo$
      @Alert("FILE "+Lo$+" DELETED!","OK",1,*Dummy%)
    Else
      Err_flag!=True
    Endif
    Sput Maan$
  Endif
  If Err_flag!
    @Alert("ERROR LOADING FILE","OK",1,*Dummy%)
    Goto Leave
  Endif
  Leave:
  If Laadflag!=False
    @Setcursor
  Endif
Return
'
Procedure Loading
  Sget Maan$
  Laadflag!=False
  Err_flag!=False
  Local Buf%,Dummy%,Lo$
  Again:
  Showm
  @Fileselectmooi("SELECT FILE TO LOAD")
  Fileselect "\*.SPW","",Lo$
  Hidem
  If Lo$=""
    Goto Out_of_it
  Endif
  If Instr(Lo$,".SPW")=False
    Goto Again
  Endif
  If Exist(Lo$)
    Open "I",#1,Lo$
    Buf%=Lof(#1)
    Close #1
    If Buf%+Len%>Res%*4
      @Alert("ERROR: NOT ENOUGH MEMORY!","OK",1,*Dummy%)
      Err_flag!=True
      Goto Out_of_it
    Endif
    Bload Lo$,Address%
    Len%=Buf%
    Laadflag!=True
  Else
    Err_flag!=True
  Endif
  Out_of_it:
  Sput Maan$
  Hidem
Return
'
Procedure Saving
  Sget Maan$
  Err_flag!=False
  Local Buf%,Dummy%,Lo$
  Agaan:
  Showm
  @Fileselectmooi("SELECT FILE TO SAVE")
  Fileselect "\*.SPW","",Lo$
  Hidem
  If Lo$=""
    Goto Out_of_ita
  Endif
  If Instr(Lo$,".SPW")=False
    Goto Agaan
  Endif
  @Checkdiskfreespace(Len%+1)
  If Err_flag!=False
    Bsave Lo$,Varptr(Text%(0)),Len%
  Endif
  Out_of_ita:
  Sput Maan$
  Hidem
Return
'
Procedure About
  @Alert("»10*** SPEEDWRITER II ***||Written May 17th 1989 by Richard Karsmakers|»5Original idea and program code by|»5Frank Lemmen & Richard Karsmakers","Original Communication!",1,*Dummy%)
Return
'
Procedure Checkdiskfreespace(Amount%)
  Err_flag!=False
  If Left$(Lo$,2)="A:" Or (Left$(Lo$,1)="\" And Gemdos(&H19)=0) !Drive A write
    If Dfree(1)<Amount%
      Err_flag!=True
    Endif
  Endif
  If Left$(Lo$,2)="B:" Or (Left$(Lo$,1)="\" And Gemdos(&H19)=1) !Drive B write
    If Dfree(2)<Amount%
      Err_flag!=True
    Endif
  Endif
  If Err_flag!=True
    @Alert("ERROR: NOT ENOUGH ROOM ON DISK","OK",1,*Dummy%)
  Endif
Return
'
Procedure Quit
  @Alert("QUIT TO DESKTOP||Are you sure?","YES|NO",2,*Dummy%)
  If Dummy%=1
    @Coff
    Edit
  Endif
Return