;************************************ ;* * ;*(C)Copyright 1986 by Paul B. Loux * ;* * ;* These routines are in the public * ;* domain, and are not to be sold * ;* for a profit. They may be freely * ;* distributed, provided that this * ;* header remains in place. Use and * ;* enjoy! PBL, CIS 72337,2073. * ;* * ;************************************ ;* * ;* File "ENTRYS.LIB" * ;* * ;* Description: Universal string * ;* input routine, offering full * ;* control over keyboard input * ;* and screen display. Allows * ;* program to limit responses * ;* to acceptable parameters. * ;* * ;* Calling parameters: * ;* * ;* FIELD The field buffer. * ;* * ;* MIN Minimum number of * ;* characters for * ;* valid response, 0-MAX.* ;* * ;* MAX Maximum number of * ;* characters, 1-36. * ;* * ;* TYPEC Type Code: * ;* 1 Alphanumeric * ;* 2 Force Upper Case * ;* 3 Signed integer * ;* 4 Signed real (float) * ;* 5 Unsigned integer * ;* 6 Unsigned real * ;* 7 Yes/No check * ;* (Note: no range check * ;* is provided on the * ;* numeric response) * ;* * ;* XIT Exit record if the * ;* first character in * ;* FIELD is ESC. * ;* * ;* COL Screen display * ;* horizontal position * ;* for input echo, 2-37. * ;* * ;* ROW Screen display * ;* vertical position * ;* for input echo, 1-22. * ;* * ;* ERRPTR Pointer variable to * ;* pass error code on * ;* record aborts (Ctrl-Z)* ;* or XIT's (above). * ;* * ;* Note: User entry of ESC will* ;* restart field entry, * ;* or exit (see above). * ;* Entry of Ctrl-Z aborts* ;* record. The routine * ;* uses the BYTE FUNC * ;* Fetch() to obtain the * ;* keystokes, allowing * ;* timeout control. * ;* * ;************************************ ; ; Atari OS Variables for sound ; control and PROC Sound_reset. ; MODULE BYTE AudCtl=$D208, SKCtl=$D20F, AudC1 =$D201, AudC2=$D203, AudC3 =$D205, AudC4=$D207 PROC Sound_reset() AudCtl=0 SKCtl=3 AudC1 =0 AudC2=0 AudC3=0 AudC4=0 RETURN ; ;************************************ ; ; BYTE FUNC FetchD ; (BYTE ioch,Time_out) ; ; This function is an enhancement ; to the library routine GetD(). ; Basically it is a GetD() with a ; timeout spec. The routine uses ; the Atari System Timer 4, whose ; counter is located at $21E,$21F ; and whose zero-flag is located ; at $22C. Normally, the function ; RETURNs the same ATASCII code ; that a GetD() would. However, ; if no key is pressed prior to ; time-out, the function RETURNs ; an ATASCII value of 255. Should ; a user actually try to enter a ; character-255, the key sequence ; is ignored. ; ; Through use of the OS variable ; POKMSK, FetchD() disables the ; Break key upon each call. ; ; The value in the BYTE Time_Out ; represents the time limit in ; seconds. A value of zero means ; that there is no time limit. ; The maximum value for Time_out, ; 255, represents 4 minutes and ; fifteen seconds. If more time ; is required, try using a short ; Time_out but use a loop to make ; the call to FetchD(), or modify ; the routine to use a CARD. ; ; The BYTE ioch represents the ; IOCB channel from which input ; is to be obtained. The routine ; assumes the channel has already ; been opened for input from K:. ; ; BYTE FUNC FetchD(BYTE ioch,Time_Out) BYTE POKMSK=$10 ; IRQ nabl bits CARD CDTMV3=$21E ; timer 4 value BYTE CDTMF3=$22C ; timer 4 flag BYTE CH=$2FC ; key pressed BYTE IRQEN=$D20E ; Pokey IRQ CARD jiffies BYTE response POKMSK==&127 ; disable Break IRQEN==&127 jiffies=Time_Out*60 CH=255 CDTMF3=255 CDTMV3=jiffies DO IF CH#255 THEN response=GETD(ioch) IF response#255 THEN RETURN(response) FI FI UNTIL CDTMF3=0 OD ;POKMSK==%128 ; uncomment to ;IRQEN==%128 ; restore BRKKEY RETURN(255) ; ;************************************ ; ; This routine places a message ; at the bottom of the screen. ; PROC MSG(BYTE code) BYTE ARRAY mesag CARD ARRAY index(10) CARD ctr BYTE ROWCRS=$54,row CARD COLCRS=$55,col index(0)=" " index(1)="Too short-- continue" index(2)="Too long-- press RETURN or Edit" index(3)="Record aborted-- press ESC to clear" index(4)="Numeric input only-- continue" index(5)="Positive numbers only-- continue" index(6)="Integers only-- continue" index(7)="Value out of range-- press ESC" index(8)="Invalid date-- press ESC" index(9)="PROGRAM ERROR-- press ESC to bypass" IF code>9 THEN code=9 FI mesag=index(code) IF code>0 THEN Sound_reset() SOUND(0,20,10,10) FOR ctr=1 TO 2000 DO ; OD Sound_reset() FI row=ROWCRS col=COLCRS POSITION(1,23) PUT(156) ; delete line PRINT(mesag) IF code=9 THEN PUT(253) FI IF code=3 OR code=7 OR code=8 OR code=9 THEN DO ctr=FETCHD(7,10) ; 10 second UNTIL ctr=27 OR ctr=255 ; timeout OD FI COLCRS=col+1 ROWCRS=row PUT(30) RETURN ;************************************ ; ; This is the actual Entry routine. ; PROC ENTRYS (BYTE ARRAY field BYTE min,max,typec,xit, col,row BYTE POINTER errptr) BYTE dotflg,code,ctr,chr,intrpt,accept BYTE ROWCRS=$54 CARD COLCRS=$55 DEFINE FILLCHR="46" ; "." BYTE INVFLG=$2B6 BYTE SHFLOK=$2BE BYTE SHFTMP IF col+max> 38 OR row>22 OR col<2 OR max1 THEN ctr==-1 IF (typec=5 OR typec=6) AND field(ctr)=46 THEN dotflg=0 FI field(ctr)=32 PUT(30) PUT(FILLCHR) PUT(30) MSG(0) FI ELSEIF chr=26 THEN ; Ctrl-Z FOR ctr=1 TO max DO field(ctr)=32 OD ctr=0 MSG(3) errptr^=2 intrpt=1 EXIT ELSEIF chr=27 THEN ; ESC IF ctr>1 THEN COLCRS=col-1 ROWCRS=row FOR ctr=1 TO max DO PUT(FILLCHR) field(ctr)=32 OD ctr=1 dotflg=0 COLCRS=col ROWCRS=row PUT(30) ELSE IF xit=1 THEN errptr^=1 intrpt=1 EXIT FI FI ELSEIF ctr>max THEN MSG(2) ELSEIF (chr<32 OR chr>122 OR chr=96) ; Goofy Keys THEN SHFLOK=0 INVFLG=0 ELSEIF typec=7 THEN ;yes/no IF chr=110 OR ;'n chr=121 THEN;'y chr==-32 FI IF chr=89 OR ;'Y chr=78 THEN;'N accept=1 FI ELSEIF typec=2 THEN ; FORCE UC IF chr>96 AND chr<123 THEN chr==-32 FI accept=1 ELSEIF chr=45 THEN ; "-" code=4 IF ctr=1 THEN code=5 FI IF typec>4 THEN MSG(code) ELSEIF typec>2 THEN IF ctr>1 THEN MSG(4) ELSE accept=1 FI ELSE accept=1 FI ELSEIF chr=46 THEN ; "." IF typec=4 OR typec=6 THEN IF dotflg=0 THEN dotflg=1 accept=1 ELSE MSG(4) FI ELSEIF typec=3 OR typec=5 THEN MSG(6) ELSE accept=1 FI ELSEIF typec>2 THEN ; digits only IF chr<48 OR chr>57 THEN MSG(4) ELSE accept=1 FI ELSE accept=1 FI UNTIL accept OD IF intrpt=1 THEN IF chr=155 THEN ; RTN MSG(0) COLCRS=col-1 ROWCRS=row field(0)=ctr-1 PRINT(field) errptr^=0 FI EXIT ; ESC,^Z,time ELSE PUT(chr) ; accept chr field(ctr)=chr MSG(0) FI OD SHFLOK=SHFTMP RETURN MODULE ; continue ; ;************************************ ; ; END OF FILE. ; ;************************************ ;************************************ ; ; Example of usage of EntryS(). PROC Test() BYTE x,y,min,max,typec,xit BYTE ARRAY name="xxxxxxxxxxxxxxx", id_no="xxxx", state="xx", price="xxxxxxxx" BYTE errcde BYTE POINTER errptr errcde=0 errptr=@errcde PUT(125) POSITION(5,5) PRINT("Enter Full Name: ") x=22 y=5 min=0 max=15 typec=1 xit=1 EntryS(name,min,max,typec, xit,x,y,errptr) POSITION(5,7) PRINT("Enter I.D. Number: ") x=24 y=7 min=4 max=4 typec=5 xit=0 EntryS(id_no,min,max,typec, xit,x,y,errptr) POSITION(5,9) PRINT("Enter State: ") x=18 y=9 min=2 max=2 typec=2 EntryS(state,min,max,typec, xit,x,y,errptr) POSITION(5,11) PRINT("Enter Price: ") x=18 y=11 min=0 max=8 typec=6 EntryS(price,min,max,typec, xit,x,y,errptr) POSITION(5,14) PUTE() PRINTE(name) PRINTE(id_no) PRINTE(state) PRINTE(price) PUTE() PRINTE("Done...") RETURN