MODULE 'dos/rdargs', 'dos/dostags', 'utility/tagitem', 'dos/dos'

ENUM OK,MEM,OPEN,READ,ARGS,CTRLC,ARG_IN=0,ARG_OUT,ARG_ERR,ARG_SIM,
     ARG_MOO,ARG_MAX

RAISE MEM   IF List()=NIL,
      MEM   IF String()=NIL,
      OPEN  IF Open()=NIL,
      ARGS  IF ReadArgs()=NIL,
      "^C"  IF CtrlC()=TRUE

PROC randasc(easy)
DEF test=0
 SELECT easy
  CASE 0
   RETURN "A" + Rnd(26)
  CASE 1
   RETURN IF Rnd(100)>50 THEN "A" + Rnd(26) ELSE "a" + Rnd(26)
  CASE 2
   test:=Rnd(100)
   IF test < 33 THEN RETURN "A" + Rnd(26)
   IF test < 66 THEN RETURN "a" + Rnd(26)
   RETURN "0" + Rnd(10)
  CASE 4
   RETURN Rnd(254)+1
  DEFAULT
   RETURN "!" + Rnd(92)
 ENDSELECT
ENDPROC


PROC main() HANDLE

 DEF in=0,out=0,gramwidth=0,xdepth=0,col,pattern,stderr=0,arg_format,
     patternbeg,patternend,buf,template,xtrahelp,myarg:PTR TO rdargs,
     patterncur,indata,pat,n,p=0,del,mv,ins,rdarg:PTR TO rdargs,tmp,
     args[ARG_MAX]:LIST,easy=3
 myarg := pattern := indata := rdarg :=  stderr:= 0
 template := 'IN=INPUT/A,OUT=OUTPUT,ERR=ERRORS/K,S=SIMPLE/N/K,MOO/S'
 tmp:=Open('CONSOLE:',MODE_READWRITE)
 xtrahelp := 'Usage: mk3d IN "filename" [OUT "filename"] [ERR "filename"]\n' +
 '            [S "number"]\n\n' +
 ' IN specifies a mandatory input file to read for a template.\n' +
 'OUT specifies an optional output file to write.\n' +
 'ERR specifies an optional error file to write (instead of stderr).\n' +
 '  S specifies how simple the characters should be, by this chart:\n\n' +
 '      0 = Only uppercase characters\n' +
 '      1 = Upper/lowercase characters\n' +
 '      2 = AlphaNumeric characters\n' +
 '      3 = AlphaNumeric characters with symbols (default)\n' +
 '     4+ = Anything from value 1 to 255\n\n' +
 'For information about the IN file''s format, please, read mk3d.doc.\n' +
 'NOTE: This program based on the same written for MS-DOS.\n' +
 '      Modified somewhat heavily by Joseph E. Van Riper III\n' +
 '      of the Cheese Olfactory Workshop.\n' 
  
 buf:=String(80)

/* Handle the arguments (somehow)
 */
 args[ARG_IN]:=0
 args[ARG_OUT]:=0
 args[ARG_ERR]:=0
 args[ARG_SIM]:=3
 args[ARG_MOO]:=0
 myarg:=AllocDosObject(DOS_RDARGS, TAG_DONE)
 myarg.exthelp := xtrahelp
 arg_format:=template
 rdarg:=ReadArgs(arg_format,args,myarg)
 CtrlC()

 FOR del:=0 TO ARG_MAX-1
  CtrlC()
  SELECT del
   CASE ARG_IN
    IF args[ARG_IN]<>0
     in := Open(args[ARG_IN], MODE_OLDFILE)
     VfPrintf(tmp,'IN: \s\n',[args[ARG_IN]])
    ELSE
     Raise(ARGS)
    ENDIF
   CASE ARG_OUT
    IF StrLen(args[ARG_OUT]) AND (args[ARG_OUT]<>0)
     out := Open(args[ARG_OUT], MODE_NEWFILE)
     VfPrintf(tmp,'OUT: \s\n',[args[ARG_OUT]])
    ELSE
     out := stdout
    ENDIF
   CASE ARG_ERR
    IF StrLen(args[ARG_ERR]) AND (args[ARG_ERR]<>0)
     VfPrintf(tmp,'ERR: \s\n',[args[ARG_ERR]])
     stderr:=Open(args[ARG_ERR],MODE_NEWFILE)
    ELSE
     stderr:=Open('NIL:',MODE_NEWFILE)
    ENDIF
   CASE ARG_SIM
    easy := args[ARG_SIM]
   CASE ARG_MOO
    IF args[ARG_MOO]
     WriteF('\nCongrads.. you''re very observant!\n' +
            'Unfortunately, all you get is a nice little:\n' +
            'Mooooooooo.\n')
     ENDIF
   DEFAULT
    Raise('$VER: mk3d 1.0 (8.1.94)')
  ENDSELECT
 ENDFOR
/* READ IN GRAMWIDTH: STEREOGRAM WIDTH (INCLUDE 2*XDEPTH + FEW MORE)
 */

 IF ReadStr(in, buf) = TRUE THEN Raise(READ)
 gramwidth := Val(buf,NIL)
 VfPrintf(stderr,'Gramwidth: \d\n',[gramwidth])
 IF ( (gramwidth < 1) OR (gramwidth > 512) )
  Raise("GRAM")
 ENDIF

 /* READ IN XDEPTH: LENGTH OF REPEATING BG PATTERN
  */
 IF ReadStr(in, buf) = TRUE THEN Raise(READ)
 xdepth := Val(buf,NIL)
 VfPrintf(stderr,'Xdepth: \d\n',[xdepth])
 IF ( (xdepth < 5) OR (xdepth > 64) OR ((xdepth*2) > gramwidth) )
  Raise("XDEP")
 ENDIF

 /* PRINT FUSION X'S
  */
 FOR col:=1 TO gramwidth-1
  CtrlC()
  FputC( out, IF Mod(col,xdepth) THEN " " ELSE "X" )
 ENDFOR
 FputC( out, 10 )
 

 /* SEED RANDOM NUMBER GENERATOR (if desired)
  */

 Rnd(-(VbeamPos()))

 pattern := List(xdepth+1)
 indata := String(gramwidth+1)

 /* IF NOT EOF, GET A LINE OF DATA
  */
 WHILE (ReadStr(in,indata)<>-1)
  /* GENERATE A NEW RANDOM PATTERN,
   * OUTPUT FULL PATTERN TO START THE LINE
   */
  CtrlC()
  FOR pat:=0 TO xdepth
   CtrlC()
   pattern[pat] := randasc(easy)
   IF pat <> xdepth THEN FputC ( out, pattern[pat] )
  ENDFOR

  /* N IS VALUE OF NEXT CHAR, P IS VALUE OF PREVIOUS CHAR
   */

  patterncur := patternbeg := col := p := n := 0
  patternend := xdepth

  /* WHILE NOT EOL
   */
  WHILE (col < (gramwidth-xdepth))
   /* SET N TO VALUE OF NEXT CHAR
    */
   CtrlC()
   IF ( (indata[col] >= "1") AND (indata[col] <= "9") )
    n := indata[col] - "0"
    VfPrintf(stderr,'\d',[n])
   ELSE
    n := 0
    VfPrintf(stderr,' ',0)
   ENDIF

   /* IF NEXT VALUE IS NOT THE SAME AS THE PREV VALUE (LEVEL SHIFT)
    */
   IF (n <> p)
    /* IF SHIFTING 'UP' (CLOSER TO USER)
     */
    IF (n > p)
     /* DEL NEXT N-P BITS IN PATTERN
      */
     FOR del := 0 TO (n-p-1)
      CtrlC()
      mv := patterncur
      REPEAT
       CtrlC()
       pattern[mv]:=pattern[mv+1]
       INC mv
      UNTIL (mv=(patternend+1))
      DEC patternend
      IF (patterncur = patternend) THEN patterncur := patternbeg
     ENDFOR
    /* SHIFTING 'DOWN' (AWAY FROM USER)
     */
    ELSE
     /* INSERT P-N RANDOM BITS INTO PATTERN
      */
     FOR ins := 0 TO (p-n-1)
      CtrlC()
      FOR mv:=patternend+2 TO patterncur+1 STEP -1
       CtrlC()
       pattern[mv]:=pattern[mv-1]
      ENDFOR
      pattern[patterncur]:=randasc(easy)
      INC patternend
     ENDFOR
    ENDIF

    /* UPDATE P
     */
    p := n

    /* OUTPUT NEXT CHAR IN RANDOM PATTERN
     */
    FputC(out,pattern[patterncur])
    
   /* NEXT VALUE IS SAME AS PREVIOUS VALUE
    */
   ELSE
    /* OUTPUT NEXT CHAR IN RANDOM PATTERN
     */
    FputC(out,pattern[patterncur])
    
   ENDIF
  /* ADVANCE PATTERN PTR
   */
   INC patterncur
   IF (patterncur = patternend) THEN patterncur := patternbeg

  /* ADVANCE INPUT PTR
   */
   INC col
  ENDWHILE
  /* END OF LINE: OUTPUT NEWLINE CHAR, CLEAN LINE BUFFER
   */
  Fputs(out,'\n')
  Fputs(stderr,'\n')
  FOR del:=0 TO gramwidth+1
   indata[del]:=0
  ENDFOR
 ENDWHILE

 /* END OF FILE: DONE, CLOSE UP
  */
 Raise(0)

EXCEPT

 IF in THEN Close(in)
 IF out AND (out<>stdout) THEN Close(out)
 IF pattern THEN Dispose(pattern)
 IF indata THEN Dispose(indata)
 IF rdarg THEN FreeArgs(rdarg)
 IF myarg THEN FreeDosObject(DOS_RDARGS,myarg)
 IF stderr THEN Close(stderr)
 stderr:=tmp
 
 p := 'something (maybe internal error).\n'
 n := IoErr()

 SELECT exception
 
  CASE OK
   p := 0
  CASE OPEN
   VfPrintf(stderr,'Cannot open ',0)
   IF (in=NIL)
    VfPrintf(stderr,'infile.\n',0)
   ELSEIF (out=NIL)
    VfPrintf(stderr,'outfile.\n',0)
   ELSE
    VfPrintf(stderr,p,0)
   ENDIF
   p := 10
  CASE MEM
   VfPrintf(stderr,'Unable to allocate memory for ',0)
   IF (pattern=NIL)
    VfPrintf(stderr,'pattern.\n',0)
   ELSEIF (indata=NIL)
    VfPrintf(stderr,'incoming data.\n',0)
   ELSE
    VfPrintf(stderr,p,0)
   ENDIF
   p := 20
  CASE "GRAM"
   VfPrintf(stderr,'Gramwidth value must be between 1 and 512.\n',0)
   p := 10
  CASE "XDEP"
   VfPrintf(stderr,'Xdepth value must be between 5 and 64\n' +
          '(and less than half the stereogram width).\n',0)
   p := 10
  CASE ARGS
   VfPrintf(stderr,xtrahelp,0)
   p := 5
  CASE READ
   VfPrintf(stderr,'Error while reading input file.\n',0)
   p := 10
  CASE "^C"
   VfPrintf(stderr,'mk3d: ***Break\n',0)
   n := 0
   p := 20
  DEFAULT
   VfPrintf(stderr,'Extremely Awful Internal Error.  Mention following to author:\n',0)
   VfPrintf(stderr,'\s\n',[exception])
   p := 20
 ENDSELECT
 
 SetIoErr(n)
 buf:=String(100)
 IF IoErr()
  Fault(IoErr(),'mk3d',buf,100)
  VfPrintf(stderr,buf,0)
 ENDIF
 VfPrintf(stderr,'\n',0)
 IF stderr THEN Close(stderr)
 CleanUp(p)

ENDPROC