2006-01-13 00:36:28 UTC
Source code is below, shall upload properly at some point soon.
rem --- Serial Reader v0.01 by Lance Wicks.
rem
rem --- Original OPL Core by Ewan Spence
rem
rem --- TODO
rem --- Everything vaguely works, timeto learn how to read a file.
rem
INCLUDE "AppFrame.oxh"
INCLUDE "System.oxh"
INCLUDE "Const.oph"
INCLUDE "SendAs.oxh"
CONST KCBAButton_1%=1
CONST KCBAButton_2%=2
CONST KCBAButton_3%=3
CONST KCBAButton_4%=4
CONST KFreeKeyAddToDesk%=1
CONST KFreeKeyToggleIrDA%=2
CONST KToggleIrDAKey%=154
CONST K_Author_Email$="
lw@judocoach.com"
CONST K_Author_Name$="Lance Wicks"
CONST K_App_Name$="Serial Reader"
CONST k_App_Ver$="0.01"
CONST KReadChunk&=&2000
PROC main:
GLOBAL id%(16),dia%
GLOBAL path$(255),data$(255),drive$(2),gfx$(16)
GLOBAL breakout%,MenuPos%
GLOBAL swidth%,sheight%,mwidth%,mheight%
GLOBAL AfCBA%, AfStatusType%,AfStatusOn%,AfTitleOn%
GLOBAL evStat%,ev&(16),AfCBADefaultButton%
GLOBAL SaCascs$(KMaxSendAsTypes%,KMaxSendAsCaptionLen%)
GLOBAL SaKeys&(KMaxSendAsTypes%),SaMaxTypes&,SaNextFreeKey&
GLOBAL sound_vol%
GLOBAL speed%
GLOBAL file$(255)
GLOBAL test_text$(255)
GLOBAL count%
GLOBAL word_start%
GLOBAL word_end%
GLOBAL pOutBuffer&
GLOBAL bufferSize%
speed% = -5
count% = 1
word_start%=1
word_end%=1
test_text$="hello world 1 2 3 4 5 . .. ... This application is designed to help you speed read . .. ... Press_the_open_button_to_begin "
init:
Init_SetupSendAsKeysAndMenu:
init_app:
DO
g_event_loop:
UNTIL breakout%<>0
breakout%=0
exit:
ENDP
PROC init:
LOCAL first%
SetFlags &10000
giPRINT K_App_Name$+", "+K_Author_Name$+" 2005, ver "+K_App_Ver$
rem *** INI File Handling
first%=LoadINIFile:
rem *** Screen dimensions, colour fixed across all devices
gSETWIN 92,0,640,200
swidth%=640 : sheight%=200
mwidth%=640-92 : mheight%=200 : rem With Toolbars
MenuPos%=AfMenuPaneToStartShowing%:
rem *** Set up Command Buttons
AfSetCBAButton:(KCBAButton_1%,"Open",0,0,"g_HandleCBA")
AfSetCBAButton:(KCBAButton_2%,"Faster",0,0,"g_HandleCBA")
AfSetCBAButton:(KCBAButton_3%,"Slower",0,0,"g_HandleCBA")
AfSetCBAButton:(KCBAButton_4%,"Close",0,0,"g_HandleCBA")
AfSetTitle:("Serial Reader - "+file$,KAfTitleTypeMainTitle%)
rem *** Set up Sendas stuff
rem SetupSendAsKeysAndMenu:
rem *** Draw AppFrame as Required
AfSetStatus%:(AfStatusType%)
AfSetCBAVisible%:(AfCBA%)
AfSetStatusVisible%:(AfStatusOn%)
AfSetTitleVisible%:(AfTitleOn%)
rem *** Create Initial Windows
rem *** 1 = fullscreen window (with large toolbar)
id%(1)=gCREATE(92,0,mwidth%,mheight%,1,KDefaultWin256ColorMode%)
rem *** Load Initial Graphics
rem *** Show splash screen if required
rem show_splash:
gAT (mwidth%-220)/2,(mheight%-55)/2
gPRINT "press any key to begin"
get
RETURN first% : rem first app is run returns 1
ENDP
PROC LoadINIFile:
IF EXIST ("c:"+data$+"serialreader.ini")
OPEN "c:"+data$+"serialreader.ini",A,file$,speed%,sound_vol%,statustype%,cba%,statuson%,titleon%
file$=A.file$
speed%=A.speed%
sound_vol%=A.sound_vol%
AfStatusType%=A.StatusType%
AfCBA%=A.cba%
AfStatusOn%=A.statuson%
AfTitleOn%=A.titleon%
CLOSE
RETURN 0
ELSE
rem *** Set initial values here
file$="start.txt"
speed%=-5
sound_vol%=3
AfStatusType%=0
AfCBA%=1
AfStatusOn%=1
AfTitleOn%=1
SaveINIFile:
RETURN 1
ENDIF
ENDP
PROC SaveINIFile:
TRAP MKDIR "c:"+data$
TRAP DELETE "c:"+data$+"serialreader.ini"
CREATE "c:"+data$+"serialreader.ini",A,file$,speed%,sound_vol%,statustype%,cba%,statuson%,titleon%
A.sound_vol%=sound_vol%
A.statustype%=AfStatusType%
A.cba%=AfCBA%
A.statuson%=AfStatusOn%
A.titleon%=AfTitleOn%
A.speed%=speed%
A.file$=file$
APPEND
CLOSE
ENDP
PROC init_app:
gUSE id%(1)
gAT (mwidth%-169)/2,(mheight%-55)/2
rem gCOPY id%(9),000,0,169,55,3
ENDP
PROC Init_SetupSendAsKeysAndMenu:
LOCAL foo%
SaScanSendAsTypes:
SaMaxTypes&=SaMaximumTypes&:
SaNextFreeKey&=SaNextAvailableHotkey&:
IF SaNextFreeKey&=KSendAsHotKeyStart&
SaNextFreekey&=0
ENDIF
foo%=1
WHILE foo%<=SaMaxTypes&
IF SaCapabilitySupported%:(foo%,KCapabilityBodyText&)
SaCascs$(foo%)=SaCascName$:(foo%)
SaKeys&(foo%)=SaHotKeyValue&:(foo%)
ELSE
SaCascs$(foo%)=""
SaKeys&(foo%)=0
ENDIF
foo%=foo%+1
ENDWH
ENDP
PROC g_event_loop:
LOCAL c$(255),AfOffered%,status%
DO
show_word:
GETEVENTA32 status%,ev&()
rem *** Check System Messages
c$=GETCMD$
IF LEFT$(c$,1)=KGetCmdLetterExit$ : Exit:
ELSEIF LEFT$(c$,1)=KGetCmdLetterBackup$ : Exit:
ELSEIF LEFT$(c$,1)=KGetCmdLetterBroughtToFGround$ : rem Brought To Focus
ENDIF
AfOffered%=AfOfferEvent%:(ev&(1),ev&(3),ev&(4),ev&(5),ev&(6),ev&(7))
IF AfOffered%=0
rem process event
IF (ev&(KEvAType%)<>KEvKeyDown& AND ev&(KEvAType%)<>KEvKeyUp&)
g_kbddrv:(ev&(KEvAType%),ev&(KEvAKMod%),ev&(KEvAScan%))
ENDIF
ENDIF
UNTIL breakout%<>0
ENDP
PROC g_kbddrv:(aKey&,aMod&,aScanCode&)
LOCAL Key&,Mod&,CapsLock%,Shift%,Ctrl%,Fn%,AllMods&
LOCAL CtrlShiftMod&,CtrlShiftFnMod&,CtrlFnMod&,ShiftFnMod&
rem *** Calculate modifiers
AllMods&=KKmodShift% OR KKModControl% OR KKModFn%
CtrlShiftMod&=KKModControl% OR KKModShift%
CtrlShiftFnMod&=CtrlShiftMod& OR KKModFn%
ShiftFnMod&=KKModShift% OR KKModFn%
CtrlShiftMod&=KKModControl% OR KKModShift%
CapsLock%=KFalse% : Shift%=KFalse% : Ctrl%=KFalse% : Fn%=KFalse%
Key&=aKey& : Mod&=aMod&
rem *** Check Caps Lock
IF (aMod&>=KKModCaps% AND aMod&<KKModFn%) OR (aMod&>=KKModCaps%+KKModFn% AND aMod&<AllMods&)
CapsLock%=KTrue%
Mod&=aMod&-KKModCaps%
ELSEIF (aMod&>AllMods&)
Mod&=0
ENDIF
rem *** Examine Modifiers
IF (Mod&-KKModFn%)>=0 : Fn%=KTrue% : Mod&=Mod&-KKModFn% : ENDIF
IF (Mod&-KKModControl%)>=0 : Ctrl%=KTrue% : Mod&=Mod&-KKModControl% : ENDIF
IF (Mod&-KKModShift%)>=0 : Shift%=KTrue% : Mod&=Mod&-KKModShift% : ENDIF
rem *** Handle System Keys
IF (Key&=KKeyMenu32&) OR (Key&=KKeySidebarMenu32&)
Key&=g_menu&:
IF (Key&>=ASC("A")) AND (Key&<=ASC("Z"))
Key&=Key&-(ASC("A")-1) : Ctrl%=KTrue% : Shift%=KTrue%
ELSE
Key&=Key&-(ASC("a")-1) : Ctrl%=KTrue% : Shift%=KFalse%
ENDIF
ELSEIF Key&=KKeyHelp32&
giPRINT "Show Help File"
rem SHOWHELP
RETURN
ENDIF
rem *** Modify amd create %? key value
Mod&=0
IF shift% : Mod&=Mod&+KKModShift% : ENDIF
IF ctrl% : Mod&=Mod&+KKModControl% : ENDIF
IF fn% : Mod&=Mod&+KKModFn% : ENDIF
Key&=Key&+ASC("a")-1
IF Mod&=CtrlShiftMod&
Key&=Key&-(ASC("a")-ASC("A"))
ENDIF
rem *** Letter Handler
IF Mod&=0 AND (aScanCode&=KScanEnter%)
rem *** Enter... the default CBA button
rem HandleCBA:(AfCBADefaultButton%)
ELSEIF mod&=0 AND (aScanCode&=KScanTab% OR aScanCode&=KScanDel%)
rem *** Prevent Tab/Delete acting as Ctrl-i/-h
RETURN
ELSEIF (Key&=KToggleIrDAKey% AND Fn%=KTrue% AND (Ctrl%=KFalse% AND Shift%=KFalse%)) OR (Key&=SaNextFreeKey&+KFreeKeyToggleIrDA%)
AfToggleIrDA:
RETURN
ELSEIF Fn%
rem *** Ignore any other Fn Keys
RETURN
ELSEIF Key&=SaNextFreeKey&+KFreeKeyAddToDesk%
AfAddToDesk:
ELSEIF (Key&>=KSendAsHotkeyStart&) AND (Key&<SaNextFreeKey&)
g_email_author:(Key&)
rem *** Letter Key (app dependent) from here onwards
ELSEIF Key&=%A : g_about:
ELSEIF Key&=%e : exit:
ELSEIF Key&=%E : g_email_author:(2)
rem *** If you want info sent by another method, change (x) to
rem *** where 1=SMS 2=Email 3=Fax
ELSEIF Key&=%k : g_prefs:
ELSEIF Key&=%L : afLaunchSystemLog:
ENDIF
ENDP
PROC g_menu&:
LOCAL foo&
mINIT
mCARD "File","Add to Desk",(SaNextFreeKey&+KFreeKeyAddToDesk%)
mCARD "Tools","Preferences...",%k,"About "+K_App_Name$+"...",-%A,"Email The Author",-%E,"Log",%L,"Receive via infrared",SaNextFreeKey&+KFreeKeyToggleIrDA%
foo&=MENU(MenuPos%)
RETURN foo&
ENDP
PROC g_HandleCBA:(button&)
IF button&=KCBAButton_1%
open_file:
ELSEIF button&=KCBAButton_2%
faster:
ELSEIF button&=KCBAButton_3%
slower:
ELSEIF button&=KCBAButton_4%
breakout%=1
ENDIF
ENDP
PROC g_elsedrv:
ENDP
PROC g_about:
rem EXTERNAL dia%
LOCAL foo_s%,foo_e&(16)
LOCK ON
id%(8)=gCREATE(INT(swidth%-310)/2,(INT(sheight%-150)/2)+(15*AfTitleOn%),310,150,0,$411)
gXBORDER 2,$94
gAT 123,18
gBOX 64,50
gFONT 10 : gSTYLE 1 : gAT 5,13
gPRINTB K_Author_Name$+" Presents...",300,3
gFONT 12 : gSTYLE 1 : gAT 5,87
gPRINTB K_App_Name$,300,3
gFONT 10 : gSTYLE 1 : gAT 5,104
gPRINTB "Version "+K_App_Ver$+", "+K_Author_Name$+", 2002",300,3
gAT 10,110 : gLINEBY 290,0
gFONT 10 : gSTYLE 0 : gAT 5,126
gPRINTB "Any comments? Mail them to",300,3
gFONT 10 : gSTYLE 0 : gAT 5,141
gPRINTB K_Author_Email$,300,3
gVISIBLE ON
DO
GETEVENTA32 foo_s%,foo_e&()
GETEVENTC (foo_s%)
PAUSE 2
UNTIL foo_e&(1)=$408 OR foo_e&(1)=$406
PAUSE 0
LOCK OFF
gCLOSE id%(8)
ENDP
PROC g_prefs:
sound_vol%=sound_vol%+1
dINIT "Preferences"
dCHOICE sound_vol%,"Sound Volume","Off,Quiet,Medium,Loud"
dBUTTONS "Close",KdBUTTONEnter%
LOCK ON : DIALOG : LOCK OFF
sound_vol%=sound_vol%-1
ENDP
PROC g_email_author:
LOCAL body&
IF SaKeys&(2)=0
giPRINT "Cannot send email at this time."
RETURN
ENDIF
ONERR cleanup::
BUSY "Preparing Email..."
body&=SaNewBody&:
SaPrepareMessage:(SaKeys&(2))
SaSetSubject%:("User Comments about "+K_App_name$+", version "+K_App_Ver$)
SaSetBody:(body&)
SaAppendToBody:("------------------------------------------------------------"+CHR$(KLineBreak&)+"Email regarding "+K_App_Name$+", version "+K_App_Ver$+"."+CHR$(KLineBreak&)+"------------------------------------------------------------")
SaAddRecipient:(K_Author_Email$)
SaLaunchSend:
SaDeleteBody:
BUSY OFF
ONERR OFF
RETURN
cleanup::
ONERR OFF
BUSY OFF
InfoDialog:("Cannot send email at this time","","")
IF body& : SaDeleteBody: : ENDIF
ENDP
PROC exit:
LOCAL foo%
ONERR JustStop::
SaveINIFile:
rem Close all windows
foo%=0
DO
foo%=foo%+1
IF id%(foo%) : gCLOSE id%(foo%)
ENDIF
UNTIL foo%=16
JustStop::
ONERR OFF
STOP
ENDP
PROC show_word:
local tword$(255)
local length%
local bufferlen%
local foo%
if count%<>len(test_text$)+1
tword$=mid$(test_text$,count%,1)
if tword$=" "
length%=count%-word_start%
tword$=mid$(test_text$,word_start%,length%)
gAT 0,(mheight%)/2
gPRINTB tword$,mwidth%,3
word_start%=count%+1
pause -3
endif
count%=count%+1
gCLS
endif
if count%=len(test_text$)+1
gAT (mwidth%-169)/2,(mheight%-55)/2
gPRINT tword$
gAT (mwidth%-169)/2,(mheight%-10)/2
gPRINT "_END_"
endif
ENDP
PROC xShow_word:
local tword$(255)
local length%
local textlen%
local foo%
if count%<>len(test_text$)+1
tword$=mid$(test_text$,count%,1)
if tword$=" "
length%=count%-word_start%
tword$=mid$(test_text$,word_start%,length%)
gAT 0,(mheight%)/2
gPRINTB tword$,mwidth%,3
word_start%=count%+1
pause -3
endif
count%=count%+1
gCLS
endif
if count%=len(test_text$)+1
gAT (mwidth%-169)/2,(mheight%-55)/2
gPRINT tword$
gAT (mwidth%-169)/2,(mheight%-10)/2
gPRINT "_END_"
endif
ENDP
PROC open_file:
LOCAL h%,r%,i%
LOCAL c$(KMaxStringLen%)
LOCAL mystring$(KMaxStringLen%)
LOCAL buffersize%
dinit "File Open"
dbuttons "Cancel",-KDButtonEsc%, "OK",KDButtonEnter%
dfile file$,"File,Folder,Disk",0
dialog
pOutBuffer&=TextFileLoadIntoBuffer&:(file$)
count%=1
word_start%=1
test_text$=GetStrFromBuf$:(pOutBuffer&)
ENDP
PROC faster:
speed%=speed+1
ENDP
PROC slower:
speed%=speed-1
ENDP
PROC TextFileLoadIntoBuffer&:(aFileName$)
LOCAL pBuffer&,InFilesize&
LOCAL hInfile%,IOmode%,r%,IOreturn&
rem // allocate buffer according to file size
InFilesize&=SyFileSize&:(aFileName$)
Message:("Filesize: "+GEN$(InFilesize&,12))
bufferSize%=int(InFilesize&)
pBuffer&=ALLOC(InFilesize&+KReadChunk&) rem some hanging space here
rem // load text file into the buffer
IOmode%=KIOOpenModeOpen%
IOOPEN(hInfile%,aFileName$,IOmode%)
r%=0
DO
IOreturn&=IOREAD(hInfile%,pBuffer&+r%*KReadChunk&,KReadChunk&)
r%=r%+1
BUSY GEN$(r%,6)
UNTIL IOreturn&<>KReadChunk&
BUSY OFF
IOCLOSE(hInfile%)
RETURN pBuffer&
ENDP
PROC Message:(aMsg$)
gIPRINT aMsg$,KBusyTopRight%
ENDP
PROC GetStrFromBuf$:(aBuffer&)
LOCAL Len&,I&,Ret$(255),p%
Len&=PEEKL(aBuffer&)
I&=0
WHILE I&<=Len&*KOplStringSizeFactor%
POKEB ADDR(Ret$)+1+KOplAlignment%+I&,PEEKB(aBuffer+I&)
I&=I&+1
ENDWH
POKEB ADDR(Ret$),Len&
P%=LOC(Ret$,CHR$(KLineBreak&)) : IF P%=0 : P%=LOC(Ret$,CHR$(KParagraphDelimiter&)) : ENDIF
WHILE P%
Ret$=LEFT$(Ret$,P%-1)+CHR$(10)+MID$(Ret$,P%+1,LEN(Ret$))
P%=LOC(Ret$,CHR$(KLineBreak&)) : IF P%=0 : P%=LOC(Ret$,CHR$(KParagraphDelimiter&)) : ENDIF
ENDWH
RETURN Ret$
ENDP