' 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%yo% AND y%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)