;-*-Midas-*-

	Title :CREATE - Create text file from keyboard input

A=1	;General porpoise
B=2
C=3
D=4
E=5
T=13	;Counter of length of text
T1=6
T2=7
T3=10
T4=11
P=17

Call=<PUSHJ P,>
Return=<POPJ P,>

TTYi==1
TTYo==2
DSKi==3
DSKo==4

PDLen==10
JCLen==10
KILen==30	;Room for 120 chars of text in kill buffer

 ;;;
;;;;;
 ;;;

Define SYSCAL op,args
	.Call [Setz ? Sixbit /op/ ? args ((Setz))]
Termin

Define TYPE &string
	Movei T1,<.Length string>
	Move T2,[440700,,[Ascii string]]
	Syscal SIOT,[%Climm,,TTYo ? T2 ? T1]
	  .Lose %LsSys
Termin

Define DBP ac			;Decrement Byte Pointer (7bit)
	Add ac,[70000,,]
	Skipge ac
	  Sub ac,[430000,,1]
Termin

 ;;;
;;;;;
 ;;;

Begin:	Move P,PDList
	Syscal OPEN,[%Clbit,,.uao\%TJDIS
		     %Climm,,TTYo
		     [Sixbit /TTY/]]
	  .Lose %LsFil
	.Break 12,[..rJCL,,JCLbuf]
	Move A,[440700,,JCLbuf]
	Syscal OPEN,[%Clbit,,.uai
		     %Climm,,TTYi
		     [Sixbit /TTY/]]
	  .Lose %LsFil
	.Suset [.rHSNAME,,Sname]
	.Suset [.rJNAME,,T1]
	Movem T1,Jname
	Came T1,[Sixbit /CREATE/]
	  Camn T1,[Sixbit /MAKE/]
	    Jrst [Setom Create
		  Jrst Parse]
	Movem T1,FN2
	Setz T2,
	Move T3,[440700,,Jname7]
	Movei T4,1
	Rotc T1,6
	Addi T2,40
	Idpb T2,T3
tLoop:	Jumpe T1,[Movem T4,Jnamel
		  Jrst Parse]
	Setz T2,
	Rotc T1,6
	Addi T2,40+32.
	Idpb T2,T3
	Aoja T4,tLoop

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;	Parse filename from JCL (optional)
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Parse:	Skipn JCLbuf
	  Jrst dFalt
6biti:	Setz T2,
	Movei T4,6
	Move T3,[440600,,T2]
6bit:	Ildb T1,A
	Caie T1,^C
	  Cain T1,^M
	    Jrst Match
	Caie T1,":
	  Cain T1,";
	    Jrst Match
	Caie T1,40	;space
	  Cain T1,",
	    Jrst Match
	Jumpe T4,6bit
	Cail T1,140
	  Trz T1,40	;Uppercase
	Subi T1,40	;7bit -> 6bit
	Idpb T1,T3
	Soja T4,6bit

Match:	Jumpn T2,Store
	Caie T1,^M
	  Cain T1,^C
	    Jrst dFalt
	Jrst 6biti

Store:	Cain T1,":
	  Jrst [Movem T2,Device
		Jrst 6biti]
	Cain T1,";
	  Jrst [Movem T2,Sname
		Jrst 6biti]
	Movei T3,FN2
	Skipn FN1
	  Movei T3,FN1
	Movem T2,(T3)
	Cain T1,40
	  Jrst 6biti

dFalt:	Skipn FN1
	  .Suset [.rXUNAME,,FN1]

CCheck:	Move T1,FN2
	Came T1,[Sixbit />/]
	  Camn T1,[Sixbit /</]
	    Skipa
CC2:	Syscal OPEN,[%Clbit,,.uai ? %Climm,,DSKi
		     Device ? FN1 ? FN2 ? Sname]
	  Setom IFile
	Skipe Create
	  Jrst TFxAE
	Skipe IFile
	  Jrst PAsk
	Type "AA "
	Call JType
	Type " file exists."
PAsk:	Type "A--"
	Call JType
	Type "?--"
	.Iot TTYi,A
	Caie A,"?
	  Cain A,%Tjdis+"H
	    Jrst [Type "
'Q' or <rubout> = Quit.  'Y' or <space> = Write over existing "
		  Call JType
		  Type ". 'V' =
View current "
		  Call JType
		  Type " (i.e. type it on terminal).  'A' means Append this "
		  Call JType
		  Type "
to the old one.  'P' means Prepend this "
		  Call JType
		  Type ".  'D' = Delete the existing
"
		  Call JType
		  Type " then Quit."
		  Jrst PAsk]
	Cain A,177
	  Jrst Die
	Cail A,140
	  Trz A,40
	Cain A,"Q
	  Jrst Die
	Caie A,"Y
	  Cain A,40
	    Jrst JIntro
	Caie A,"V
	  Jrst PorA
	Type "iew:A"
	Skipn IFile
	  Jrst VLoop
	Type "View WHAT?  There is no existing "
	Call JType
	Type " file."
	Jrst PAsk
VLoop:	.Iot DSKi,B
	Caie B,^C
	  Camn B,[-1,,^C]
	    Jrst [.Iot TTYo,[^P]
		  .Iot TTYo,["A]
		  .Access DSKi,[0]
		  Jrst PAsk]
	.Iot TTYo,B
	Jrst VLoop
PorA:	Cain A,"A
	  Jrst [Setom AorP	;<0
		Type "ppending."
		Jrst OTemp]
	Cain A,"P
	  Jrst [Movem A,AorP	;>0
		Type "repending."
		Jrst OTemp]
	Cain A,"D
	  Jrst [Syscal DELEWO,[%Climm,,DSKi]
		  .Lose %LsSys
		Type "eleted"
		Jrst Die]
	Type "? Type '?' for help."
	Jrst PAsk

OTemp:	Syscal OPEN,[%Clbit,,.uao ? %Climm,,DSKo
		     Device ? [Sixbit /_MAKE_/]
		     [Sixbit /OUTPUT/] ? Sname]
	  .Lose %LsFil
	Jrst Jintro

 ;;;
;;;;;
 ;;;

TFxAE:	Skipe IFile
	  Jrst PFName
	Type "AThe file "
	Call FType
	Type " already exists."
	Jrst Askh
Askh:	Type "AWrite over it?"
Ask:	Type " (Y/N) "
	.Iot TTYi,A
	Caie A,"Y
	  Cain A,"y
	    Jrst PFName
	Caie A,"N
	  Cain A,"n
	    Jrst Die
	.Iot TTYo,[^G]
	Jrst Ask

PFName:	Type "ACreating file "
	Call FType
	Type "   Type ^C to end input, ^_H for help.A"
	Jrst IInput

JIntro:	.Iot TTYo,[^P]
	.Iot TTYo,["A]
	Call JType
	.Iot TTYo,[":]
	.Iot TTYo,[^M]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;	Ok, files open.  Start with the TTY input and all...
;;;	fix no echo and all that first.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

IInput:	Syscal TTYGET,[%Climm,,TTYi ? %Clout,,T1
		       %Clout,,T2 ? %Clout,,T3]
	  .Lose %LsSys
	Move T1,[20202,,20202]		;No echo
	Move T2,[20202,,20202]
	Syscal TTYSET,[%Climm,,TTYi ? T1 ? T2 ? T3]
	  .Lose %LsSys
	Setz T,
	Movei D,Death
	Movem D,Page
	Syscal CORBLK,[%Climm,,%Cbprv
		       %Climm,,%Jself
		       Page
		       %Climm,,%Jsnew]
	  .Lose %LsSys
	Imuli D,2000	;The Location
	Hrli D,440700	;The Byte Pointer
	Movem D,pText

Input:	.Iot TTYi,A
	Cain A,^J		;No stray LF's in text thank you
	  Jrst Input
	Skipe Quote
	  Jrst SaveIt
	Movei T1,NSChar		;Number of Special Chars (^W, ^D, etc)
SLoop:	Camn A,SChar(T1)
	  Jrst @SHand(T1)
	Sojge T1,SLoop
SaveIt:	Aoj T,
	Camle T,MaxLen
	  Call AddPag
	Idpb A,D
	Setzm Quote
	.Iot TTYo,A
	Caie A,^M
	  Jrst Input
	Movei A,^J
	Jrst SaveIt

SQuote:	Setom Quote
	.Iot TTYo,["_]
	.Iot TTYo,[^P]
	.Iot TTYo,["B]
	Jrst Input

Help:	Type "CControl codes with special meanings are:

	^C	End input and write to file.
	^D	Flush program.
	^F	Flush all text then re-input, keeping same file.
	^G	Same as ^D.
	^L	Re-display entire text.
	^Q	Quote next character.
	^R	Re-type line.
	^U	Kill line.
	^W	Delete back word.
	^Y	Yank back last text killed by ^W or ^U.
	<Rub>	Delete back character.

All other characters are self-inserting.  If there are problems, or if
you have any suggestions, mail to BUG-CREATE c/o Grendel.î-------î"
	Call ReLine
	Jrst Input

Quitp:	Jumpe T,Die
	Type " Quit?"
AskQ:	Type " (Y/N) "
	.Iot TTYi,A
	Cail A,140
	  Subi A,40
	Cain A,"Y
	  Jrst Die
	Cain A,"N
	  Jrst [Type "No.î-------î"
		Call ReLine
		Jrst Input]
	.Iot TTYo,[^G]
	Jrst AskQ

CtrlR:	Call CLine
	Call ReLine
	Jrst Input

CtrlF:	Jumpe T,[Type "îNo text?î"
		 Jrst Input]
	Type " --Flush--"
	.Iot TTYi,B
	Caie B,40
	  Jrst [Type " No.î-------î"
		Call ReLine
		Jrst Input]
	Type "Yes.î"
	Setz T,
	Move D,pText
	Jrst CtrlL

Delete:	Jumpe T,Input
	Call DelChr
	Jrst Input

CtrlW:	Jumpe T,Input
	Setzm Alpha
	Move E,T		;Save total-length
  wtop:	Jumpe T,ToKBuf
	Ldb B,D
	Cail B,"a
	  Subi B,40
	Cail B,"A
	  Caile B,"Z
	    Jrst [Skipe Alpha
		    Jrst ToKBuf
		  Jrst .+2]
	Setom Alpha
	Call DelChr
	Jrst wtop

ToKBuf:	Sub E,T		;E now has # chars deleted
	Caile E,KILen*5
	  Movei E,KILen*5
	Movem E,LKBuf
	Move B,D	;Save current bp
	Move T1,[440700,,KilBuf]
ToK1:	Ildb T2,B
	Idpb T2,T1
	Sojn E,ToK1
	Jrst Input

CtrlU:	Jumpe T,CtrlL
	Move E,T
	Ldb B,D		;examine 1st char
	Caie B,^J
	  Jrst utag2
	.Iot TTYo,[^P]	;Up a line
	.Iot TTYo,["U]
	Jrst utag2
 utag1:	Jumpe T,CLEOL
	Ldb B,D
	Cain B,^J
	  Jrst CLEOL
 utag2:	Soj T,
	DBP D
	Jrst utag1
CLEOL:	Call CLine
	Jrst ToKBuf

CtrlL:	.Iot TTYo,[^P]
	.Iot TTYo,["C]
	Skipn Create
	  Jrst [Call JType
		Jrst ltag1]
	Type "[Entering file "
	Call FType
	.Iot TTYo,["]]
	Skipa
 ltag1:	.Iot TTYo,[":]
	.Iot TTYo,[^M]
	Jumpe T,Input
	Move T1,pText
	Move T2,T
	Syscal SIOT,[%Climm,,TTYo ? T1 ? T2]
	  .Lose %LsSys
	Jrst Input

Yank:	Skipn LKBuf
	  Jrst Input
	Move T1,T
	Add T1,LKBuf
	Camle T1,MaxLen
	  Call AddPag
	Move T,T1
	Move T1,[440700,,KilBuf]
	Move T2,LKBuf
Yank1:	Ildb B,T1
	.Iot TTYo,B
	Idpb B,D
	Sojn T2,Yank1
	Jrst Input

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;	End of input routine...  Write our hard-earned text to disk
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Save:	Skipe AorP
	  Jrst NRepl
	Syscal OPEN,[%Clbit,,.uao ? %Climm,,DSKo
		     Device ? FN1 ? FN2 ? Sname]
	  .Lose %LsFil
	Syscal RFNAME,[%Climm,,DSKo ? %Clout,,Device ? %Clout,,FN1
		       %Clout,,FN2 ? %Clout,,Sname ? %Clout,,T1]
	  .Lose %LsSys

NRepl:	Skipe IFile	;If no input file, dont worry about ap/pre
	  Jrst OutIt
	Skipl AorP
	  Jrst OutIt
aploop:	.Iot DSKi,A
	Caie A,^C
	  Camn A,[-1,,^C]
	    Jrst OutIt
	.Iot DSKo,A
	Jrst aploop

OutIt:	Syscal SIOT,[%Climm,,DSKo ? pText ? T]
	  .Lose %LsSys
	Skipe Create
	  Jrst prep
PHeadr:	.Iot DSKo,[^M]
	.Iot DSKo,[^J]
	.Iot DSKo,[^I]
	.Iot DSKo,["-]
	.Iot DSKo,["-]
	.Suset [.rXUNAME,,T1]
	Movei T3,DSKo
	Call 6Type
	.Iot DSKo,[",]
	.Iot DSKo,[" ]
	Call DateIt
	.Iot DSKo,[^M]
	.Iot DSKo,[^J]

prep:	Skipe IFile
	  Jrst Replac
	Skipg AorP
	  Jrst Replac
prloop:	.Iot DSKi,A
	Caie A,^C
	  Camn A,[-1,,^C]
	    Jrst Replac
	.Iot DSKo,A
	Jrst prloop
Replac:	Skipn AorP
	  Jrst Done
	Skipe IFile
	  Jrst Rename
	Syscal DELEWO,[%Climm,,DSKi]
	  .Lose %LsFil
Rename:	Syscal RENMWO,[%Climm,,DSKo ? FN1 ? FN2]
	  .Lose %LsFil

Done:	Type "AWritten to "
	Call FType

Die:	.Logout 1,

;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;

PDList:	-PDLen,,PDList
	Block PDLen

JCLbuf:	Block JCLen
	-1

Device:	Sixbit /DSK/
Sname:	0
FN1:	0
FN2:	Sixbit />/

DOW:	6,,[Asciz /Sunday/]
	6,,[Asciz /Monday/]
	7,,[Asciz /Tuesday/]
	9.,,[Asciz /Wednesday/]
	8.,,[Asciz /Thursday/]
	6,,[Asciz /Friday/]
	8.,,[Asciz /Saturday/]

Fillen:	0
Create:	0
IFile:	0
Quote:	0
Alpha:	0
MaxLen:	2000*5
Page:	0
AorP:	0
Jname:	0
Jname7:	Block 2
Jnamel:	0

pText:	0

SChar:	^C ? ^D ? ^F ? ^G ? ^L ? ^Q ? ^R ? ^U ? ^W ? ^Y ? 177 ? %Tjdis+"H
SHand:	Save ? Quitp ? CtrlF ? Quitp ? CtrlL ? SQuote ? CtrlR
	CtrlU ? CtrlW ? Yank ? Delete ? Help ? Yank
NSChar==SHand-SChar

KilBuf:	Block KILen
LKBuf:	0

 ;;;
;;;;;
 ;;;

AddPag:	Sos Page
	Syscal CORBLK,[%Climm,,%CBPRV
		       %Climm,,%JSELF
		       Page
		       %Climm,,%JSNEW]
	  .Lose %LsSys
	Movei T1,2000*5
	Addm T1,MaxLen
	Return

6Type:	Setz T2,
	Rotc T1,6
	Addi T2,40
	Syscal IOT,[T3 ? T2]
	  .Lose %LsSys
	Jumpn T1,6Type
	Return


FType:	Movei T3,TTYo
	Move T1,Device
	Call 6Type
	.Iot TTYo,[":]
	.Iot TTYo,[" ]
	Move T1,Sname
	Call 6Type
	.Iot TTYo,[";]
	.Iot TTYo,[" ]
	Move T1,FN1
	Call 6Type
	.Iot TTYo,[" ]
	Move T1,FN2
	Call 6Type
	Return

CLine:	.Iot TTYo,[^P]
	.Iot TTYo,["H]
	.Iot TTYo,[8.]
	.Iot TTYo,[^P]
	.Iot TTYo,["L]
	Return

ReLine:	Skipn T
	  Return
	Move B,T
  top1:	Jumpe B,bot1
	Ldb T1,D
	Cain T1,^J
	  Jrst bot1
	Soj B,
	DBP D
	Jrst top1
  bot1:	Move C,T
	Sub C,B
	Syscal SIOT,[%Climm,,TTYo ? D ? C]
	  .Lose %LsSys
	Return

DelChr:	Ldb A,D
	Soj T,
	DBP D
	Cain A,^J
	  Jrst [.Iot TTYo,[^P]
		.Iot TTYo,["U]
		Ldb A,D
		Caie A,^M
		  Return
		Jrst DelChr]
	Cain A,^M
	  Jrst [Call ReLine
		Return]
	Caie A,177
	  Caige A,40
	    Skipa
	Jrst bi
   uni:	.Iot TTYo,[^P]
	.Iot TTYo,["X]
    bi:	.Iot TTYo,[^P]
	.Iot TTYo,["X]
	Return

DateIt:	.RYear T1,
	Ldb T2,[320300,,T1]	;bits 3.9-4.2, day of week
	Move T1,DOW(T2)
	Hlrz T3,T1	;len
	Hrli T4,440700
	Hrr T4,T1	;loc
	Syscal SIOT,[%Climm,,DSKo ? T4 ? T3]	;"Sunday", etc
	  .Lose %LsSys
	.Iot DSKo,[" ]
	Movei T3,DSKo
	.RDatim A,	;HHMMSS -> A, YYMMDD -> B
	Rotc B,6*2	;xxxxYY -> C
	Move D,B	;MMDDxx -> D
	Rotc D,6*2	;xxxxMM -> E, DDxxxx -> D
	Move T1,D
	Call 6Type
	.Iot DSKo,["/]
	Lsh E,6*4
	Move T1,E
	Call 6Type
	.Iot DSKo,["/]
	Lsh C,6*4
	Move T1,C
	Call 6Type
	.Iot DSKo,[" ]	;dd/mm/yy
	Setz B,
	Rotc A,6*2	;xxxxHH -> B, MMSSxx -> A
	Lsh B,6		;xxxHHx
	Addi B,32	;xxxHH:
	Rotc A,6*2	;xHH:MM
	Lsh B,6		;HH:MMx
	Move T1,B
	Call 6Type	;hh:mm
	.Iot DSKo,[" ]
	Return

JType:	Move T1,Jnamel
	Move T2,[440700,,Jname7]
	Syscal SIOT,[%Climm,,TTYo ? T2 ? T1]
	  .Lose %LsSys
	Return

 ;;;
;;;;;
 ;;;

Variables
Constants

Death==._-12+1		;The end of the road

	END Begin