[Coco] OS9/Nitros9 HTML viewing source code

[L. Curtis Boyle]

     Found a copy of my old viewer on RTSI. Maybe it will be of use to  
someone:
I was eventually going to code on in assembly, after I finished patching  
windint/grfdrv to handle other sized fonts, etc. but never got that far.


PROCEDURE Html
(* NOTE: This is just a quick hack to view HTML files. You will have to do
(*  a BASIC09 #24k (or 32 or 40) to run it. It is best run with NitrOS9  
V2.00
(*  with my last GRFDRV patch for 224 character fonts, and with ISO-LATIN  
font
(*  I included with it (after merging the font, do a DISPLAY 1B 3A C8 3F)
(*  This is the slightly updated version I had mentioned earlier.
(*  -L.Curtis Boyle-
TYPE registers=cc,a,b,dp:BYTE;x,y,u:INTEGER
DIM regs:registers
DIM file:BYTE
DIM blank,nm$:STRING[80]
DIM ampstring,command,inline:STRING[4000]
DIM preoutcontrols,postoutcontrols:STRING[128]
DIM outline:STRING[5096]
DIM c,ampchar,temp,htmlonchar,htmloffchar:INTEGER
DIM center,noprint:BOOLEAN
DIM esc:STRING[1]
DIM boldon,boldoff:STRING[3]
DIM lf:STRING[1]
lf=CHR$(10)
blank=""
FOR temp=1 TO 40
   blank=blank+"  "
NEXT temp
esc=CHR$($1b)
boldon=esc+"="+CHR$(1)
boldoff=esc+"="+CHR$(0)
center=FALSE
noprint=FALSE
? "Hacked HTML Viewer v0.1 beta (C)1997 by L. Curtis Boyle"
? "NOTE: Make sure you have CR&LF on the file (lf+ or lf2cr followed by  
lf+)"
? "List of files to view:"
SHELL "files *.htm*"
INPUT "Which HTML file to list? ";nm$
OPEN #file,nm$:READ
preoutcontrols=""
postoutcontrols=""
SHELL "tmode -lf"
WHILE NOT(EOF(#file)) DO
   regs.a=file
   regs.x=ADDR(inline)
   regs.y=SIZE(inline)
   RUN Syscall($8b,regs)
   IF regs.y=SIZE(inline) THEN
     ? " >>>> WARNING: INPUT LINE IS TOO LONG...TRUNCATING <<<<"
   ENDIF
   inline=LEFT$(inline,regs.y-1)
(* Check for & chars - NOTE: Although the HTML spec says that & chars must  
end
(* with a ; quite a few pages do not, especially on &#nnn's
   FOR c=ADDR(inline) TO ADDR(inline)+regs.y-1
     IF PEEK(c)=9 THEN
       POKE c,32
     ENDIF
   NEXT c
   LOOP
     ampchar=SUBSTR("&",inline)
   EXITIF ampchar=0 THEN
   ENDEXIT
     outline=LEFT$(inline,ampchar-1)
     ampstring=RIGHT$(inline,LEN(inline)-ampchar)
     IF LEFT$(ampstring,1)=" " THEN
       ampchar=2
     ELSE
       ampchar=SUBSTR(";",ampstring)
     ENDIF
     inline=outline
     outline=LEFT$(ampstring,ampchar-1)
     IF outline="lt" THEN
       inline=inline+"<"
     ELSE
       IF outline="gt" THEN
         inline=inline+">"
       ELSE
         IF outline="amp" THEN
           inline=inline+"and"
         ELSE
           IF outline="quot" THEN
             inline=inline+""""
           ELSE
             IF LEFT$(outline,1)="#" THEN
               inline=inline+CHR$(VAL(MID$(outline,2,LEN(outline)-1)))
             ELSE
               IF LEFT$(outline,1)=" " THEN
                 inline=inline+"and"
                 ampchar=ampchar-2
               ENDIF
             ENDIF
           ENDIF
         ENDIF
       ENDIF
     ENDIF
     inline=inline+RIGHT$(ampstring,LEN(ampstring)-ampchar)
   ENDLOOP
   outline=""
   REPEAT
     htmlonchar=SUBSTR("<",inline)
     IF htmlonchar=0 THEN
       outline=outline+inline
       inline=""
       IF outline="" THEN
         outline=" "
       ENDIF
     ELSE
       htmloffchar=SUBSTR(">",inline)
       IF htmloffchar=0 THEN
         ? "ERROR, no closing '>' found on HTML command"
         htmloffchar=LEN(inline)+1
       ENDIF
       command=MID$(inline,htmlonchar+1,htmloffchar-htmlonchar-1)
       IF htmlonchar>1 AND noprint=FALSE THEN
         temp=LEN(LEFT$(inline,htmlonchar-1))
         IF center=FALSE OR temp>79 THEN
           outline=outline+LEFT$(inline,htmlonchar-1)
         ELSE
           outline=outline+LEFT$(blank,40-temp/2)+LEFT$(inline,htmlonchar-1)
         ENDIF
       ENDIF
       inline=RIGHT$(inline,LEN(inline)-htmloffchar)
       IF command="HEAD" OR command="head" OR command="/BODY" OR  
command="/body" THEN
         noprint=TRUE
       ELSE
         IF command="/HEAD" OR command="/head" OR command="BODY" OR  
command="body" THEN
           noprint=FALSE
         ELSE
           IF (LEN(command)=2 AND (LEFT$(command,1)="H" OR  
LEFT$(command,1)="h")) OR command="B" OR command="b" THEN
             temp=ASC(RIGHT$(command,1))
             IF (temp>48 AND temp<55) OR command="B" OR command="b" THEN
               IF command<>"B" AND command<>"b" THEN
                 center=TRUE
               ENDIF
               outline=outline+boldon
             ENDIF
           ELSE
             IF (LEN(command)=3 AND (LEFT$(command,2)="/H" OR  
LEFT$(command,2)="/h")) OR command="/B" OR command="/b" THEN
               temp=ASC(RIGHT$(command,1))
               IF (temp>48 AND temp<55) OR command="/b" OR command="/B" THEN
                 center=FALSE
                 outline=outline+boldoff
               ENDIF
             ELSE
               IF command="P" or command="p" OR command="BR" OR  
command="LI" THEN
                 outline=outline+CHR$(13)+CHR$($0a)
               ENDIF
             ENDIF
           ENDIF
         ENDIF
       ENDIF
     ENDIF
   UNTIL inline=""
   IF LEN(outline)>0 THEN
     IF RIGHT$(outline,1)<>lf THEN
       outline=outline+CHR$(13)+lf
     ENDIF
     IF LEFT$(outline,1)=lf THEN
       outline=RIGHT$(outline,LEN(outline)-1)
     ENDIF
     FOR c=ADDR(outline) TO ADDR(outline)+LEN(outline)
       IF PEEK(c)=$0a THEN
         IF PEEK(c-1)<>$0d THEN
           POKE c,0
         ENDIF
       ENDIF
     NEXT c
     regs.x=ADDR(outline)
     regs.a=1
     regs.y=LEN(outline)
     RUN Syscall($8a,regs)
   ENDIF
ENDWHILE
CLOSE #file
SHELL "tmode lf"
END


-- 
L. Curtis Boyle