; CODQT
;
; Program for Proteus
;
; (C) 2002-2004 Simone Zanella Productions
;
; Accept code/quantity and save them to file operator.TXT.

#!proteus -z

!include "console.prt"

IF LT(ARGC, 5)
  CONSOLELN "Insufficient parameters."
  CONSOLELN ""
  CONSOLELN "Syntax: proteus codqt <operator>"
  CONSOLELN "operator = data are saved to file operator.txt"
  ABORT 0
FI

Operator = UPPER(ARGV(5))

; Filename where data will be recorded
FileName = Operator ".TXT"

; Max length for code (always uppercase)
MaxCod = 50
; Max length for quantity (integer or floating point)
MaxQt  = 6

; Save screen underneath
OldScreen = DISPSAVE(1, 1, 80, 25)

; Display settings: blink, size, colours, justification, shadows
DISPSET(DISP_BLINK, DISP_BLINK_OFF)
RESIZE(24, 20)
DISPSET(DISP_FOREG, YELLOW)
DISPSET(DISP_BACKG, BLUE)
DISPSET(DISP_UNSFG, YELLOW)
DISPSET(DISP_SELBG, GREEN)
DISPSET(DISP_JUST, DISP_JUST_NONE)
DISPSET(DISP_JLEN, 0)
DISPSET(DISP_SHADOW, DISP_SHADOW_RIGHT)

; User interface
DISPCLS()
DISPBOX(1, 1, 23, 19)

; Center operator name
L = ADD(STRLEN(Operator), 2)
L = SUB(23, L)
L = DIV(L, 2)
IF LT(L, 0)
  L = 0
FI
DISPWRITE(INC(L), 1," " LEFT(Operator, 21) " ")

DISPWRITE(3, 3, "Code:")
DISPWRITE(3, 6, "Quantity:")
DISPWRITE(3, 9, "Type code")
DISPWRITE(3, 12, "F1 clear")
DISPWRITE(3, 13, "F2 delete last")
DISPWRITE(3, 14, "F5 delete all")

; Cursor state: overwrite
Insert = 0

; Phase 1: ask code
WhichStep = 1
DISPSET(DISP_FOREG, BLACK)
DISPSET(DISP_BACKG, BROWN)
Code = ""
Qt = "1"
WHILE 1
  ; Write current value for Code and Quantity
  DISPWRITE(3, 4, PADR(Code, 18, " "))
  DISPWRITE(3, 7, PADR(Qt, MaxQt, " "))
  SWITCH WhichStep EQ
  ON 1
    ; Ask code
    DISPSET(DISP_FOREG, YELLOW)
    DISPSET(DISP_BACKG, BLUE)    
    DISPWRITE(3, 9, "Type code       ")
    DISPSET(DISP_FOREG, BLACK)
    DISPSET(DISP_BACKG, BROWN)
    
    ; Starting position for cursor and initial offset in window
    Start = 0
    WinOffset = 0

    ; Make uppercase the code entered
    STATUS = GETSTRINGUDF(3, 4, @Code, MaxCod, 18, @Start, @WinOffset, @Insert, "!", CodUdf)
    IF ISEMPTY(Code)
      ; Clear requested: ask code again
      CONTINUE
    FI

    ; Here it could be checked code length
    ; IF NEQ(STRLEN(Code), 18)
    ;   Warning("Wrong length (" STRLEN(Code) ")!")
    ;   CONTINUE
    ; FI
    
    ; Ask quantity
    WhichStep = 2
  ON 2
    ; Ask quantity
    DISPSET(DISP_FOREG, YELLOW)
    DISPSET(DISP_BACKG, BLUE)    
    DISPWRITE(3, 9, "Type quantity   ")    
    DISPSET(DISP_FOREG, BLACK)
    DISPSET(DISP_BACKG, BROWN)
    
    ; Starting position for cursor and initial offset in window
    Start = 0
    WinOffset = 0

    ; Quantity can be float (mask "F") or integer (mask "N", as in this case)
    STATUS = GETSTRINGUDF(3, 7, @Qt, MaxQt, INC(MaxQt), @Start, @WinOffset, @Insert, "N", QtUdf)

    IF ISEMPTY(Qt)
      ; Clear requested: ask code again
      CONTINUE
    FI

    IF NOT(STATUS)
      ; Missing confirmation: return to code
      WhichStep = 1
    ELSE
      ; Save record
      SaveData(Code, Qt)
      Code = ""
      Qt = "1"
      WhichStep = 1
    FI
  OFF  
LOOP

; Restore screen underneath
DISPRESTORE(1, 1, 80, 25, OldScreen)
ABORT 0


FUNCTION AskYN(message)

; Display message and request user to press Y or N
oldpar = DISPPARSAVE()
DISPSET(_DISP_FOREG, _WHITE)
DISPSET(_DISP_BACKG, _RED)
DISPSET(_DISP_JUST, _DISP_JUST_CENTER)
s = DISPOSD(message " (Y/N)?")
WHILE NOT(IN(ISET(c, UPPER(CHR(GETCH(0)))), "YN"))
LOOP
DISPRESTOREOSD(s)
DISPPARRESTORE(oldpar)
RETURN STREQ(c, "Y")


FUNCTION QtUdf(car, string)

; UDF for quantity
retval = 0
SWITCH car EQ
ON 328
  ; Arrow up: return to code
  retval = 3
ON 315
  ; F1: clear quantity
  string = ""
  retval = 2
ON 316
  ; F2: delete last record
  DeleteData()  
ON 319
  ; F5: delete all records
  DeleteAll()
OFF
RETURN retval


FUNCTION CodUdf(car, string)

; UDF for code
retval = 0
SWITCH car EQ
ON 315
  ; F1: clear code
  string = ""
  retval = 2
ON 316
  ; F2: delete last record
  DeleteData()
ON 319
  ; F5: delete all records
  DeleteAll()
ON 27
  ; ESC: exit (with confirmation)
  IF AskYN("Confirm exit")
    ; Restore screen underneath
    RESIZE(80, 25)
    DISPRESTORE(1, 1, 80, 25, _OldScreen)
    ABORT 0
  FI
  retval = 5
ON 336
  ; Arrow down: request quantity
  car = 13
OFF
RETURN retval


FUNCTION Warning(message)

; Display message and wait for a keypress
oldpar = DISPPARSAVE()
DISPSET(_DISP_FOREG, _WHITE)
DISPSET(_DISP_BACKG, _RED)
DISPSET(_DISP_JUST, _DISP_JUST_CENTER)
s = DISPOSD(message)
BEEP(_BEEP_DEFFREQ, _BEEP_DEFDELAY)
GETCH(0)
DISPRESTOREOSD(s)
DISPPARRESTORE(oldpar)
RETURN

FUNCTION DeleteAll()

; Delete the file holding the data
h = FOPEN(_FileName, 1)

IF EQ(h, -1)
  Warning("File is empty!")
  RETURN
FI
FCLOSE(h)

IF AskYN("Delete all")
  ; Delete all records
  FREMOVE(_FileName)
FI
RETURN


FUNCTION DeleteData()

; Delete last record (on user confirmation)
h = FOPEN(_FileName, 4)
IF EQ(h, -1)
  Warning("File is empty!")
ELSE
  IF EQ(FSIZE(h), 0)
    Warning("File is empty!")
    FCLOSE(h)
    RETURN
  FI
  ; 10 (date) + 8 (time) + 3 (separators) + 2 (CR+LF) = 23
  FSEEK(h, NEG(ADD(_MaxCod, _MaxQt, 23)), 2)
  article = FREADLN(h)
  oldpar = DISPPARSAVE()
  screen = DISPSAVE(3, 9, 20, 18)
  DISPCLEAR(3, 9, 20, 18, _BLUE)
  DISPSET(_DISP_FOREG, _YELLOW)
  DISPSET(_DISP_BACKG, _BLUE)
  data = LEFT(article, 10)
  ora = SUBSTR(article, 12, 8)
  artcod = SUBSTR(article, 21, _MaxCod)
  qt = RTRIM(RESTFROM(article, ADD(22, _MaxCod)), " ")
  DISPWRITE(3, 9, "Cod:")
  DISPWRITE(3, 10, LEFT(artcod, 18))
  DISPWRITE(3, 12, "Qt:   " qt)
  DISPWRITE(3, 14, "Date: " data)  
  DISPWRITE(3, 16, "Time: " ora)    
  DISPWRITE(3, 18, "Delete  (Y/N)?")
  WHILE NOT(IN(ISET(c, UPPER(CHR(GETCH(0)))), "YN"))
  LOOP
  IF STREQ(c, "Y")
    FRESIZE(h, SUB(FSIZE(h), _MaxCod, _MaxQt, 23))
  FI
  FCLOSE(h)
  DISPRESTORE(3, 9, 20, 18, screen)
  DISPPARRESTORE(oldpar)
FI
RETURN


FUNCTION SaveData(code, qt)

; Save date, time, code and quantity

d = DATE()
yy = YEAR(d)
mm = MONTH(d)
dd = DAY(d)
d = PFORMAT("02d", dd) "/" PFORMAT("02d", mm) "/" PFORMAT("04d", yy)

s = d "|" RTRIM(TIME(), " ") "|" PADR(code, _MaxCod, " ") "|" PADR(qt, _MaxQt, " ") _EOL
result = -1
WHILE EQ(result, -1)
  result = FAPPEND(_FileName, s)
  IF EQ(result, -1)
    ; Error: data file is blocked
    numtry = 0

    ; Wait a random time between 1/100th of seconds and 1 second; retry 3 times
    WHILE AND(LT(numtry, 3), EQ(result, -1))
      SLEEP(FDIV(INC(RANDOM(100)), 100))
      result = FAPPEND(_FileName, s)
      IF NEQ(result, -1)
        BREAK
      ELSE
        INC(@numtry)      
      FI
    LOOP

    ; We get here if we ran out of attempts or if we could write succesfully the record
    IF EQ(result, -1)
      Warning("Data file is blocked. Press any key to retry.")
    FI
  FI
LOOP

DISPSET(_DISP_FOREG, _YELLOW)
DISPSET(_DISP_BACKG, _BLUE)    
DISPWRITE(3, 9, "= S T O R E D = ")
DISPSET(_DISP_FOREG, _BLACK)
DISPSET(_DISP_BACKG, _BROWN)    
SLEEP(0.5)

RETURN