`Import Weight Geometry from DB

IF NOT FEXIST ^^Loc8DB.rf THEN ERROR "No data base"

MACRO Loc8DB
 VARIABLE (str) dbLoc="%1"
/
MACRO FindDB
 RUN ^^Loc8DB.rf /CALL
 me "Data Base is located at {dbLoc}
/
.FindDB

MACRO FindShip
  VARIABLE (str) ship="{dbLoc}\Ships\{shipname}"
/
IF NOT VEXIST shipname THEN VARIABLE (str) shipname
IF NOT VEXIST item THEN VARIABLE item:1:999=1 ELSE SET item={item} PLUS 1
TEMPLATE AskFindShip "Find Ship & Weight Item" /nokey
 "Geometry File name in Data Base:" shipname
 break
 "Weight item number:" item /WID:3 /tt:"Item numbers are shown|in DB EditLSWt"
 "Find weight item" EXIT FindShip
/
.AskFindShip
IF {templok}=0 THEN END

VARIABLE (str) geowts="{ship}\GeoWts"
VARIABLE i, j
VARIABLE (str) s,sj1,sj2
MACRO NoScore
 set j=NEXT 0, "_", "{%1}"
 IF {j}=0 THEN EXIT
 set sj1=LEFT {j-1} "{%1}"
 set sj2=SLICE {j+1} "{%1}"
 set %1="{sj1}-{sj2}"
 EXIT NoScore "%1"
/

MACRO WtsDir
 SET s=SLICE 3,"%1"
 SET i=NEXT 0,"_","{s}"
 SET i=LEFT {i-1},"{s}"
 IF {i}<>{item} THEN EXIT
 .NoScore "s"
 nFiles:={nFiles+1}
 VARIABLE (str) file{nFiles}="{s}"
 SET i=NEXT 0,"-","{s}"
 SET s=SLICE {i+1},"{s}"
 SET i=NEXT 0,"@","{s}"
 IF {i}>12 THEN SET i=13
 SET s=LEFT {i-1},"{s}"
 VARIABLE (str) partname{nfiles}="{s}"
 VARIABLE (str) fullname{nFiles}="%1.GF"
 VARIABLE (str) type{nfiles}="SAIL"
 VARIABLE ifile{nFiles}=0
/
VARIABLE nFiles=0
DIR "{geowts}\*.GF" /MAC:WtsDir
IF {nFiles}=0 THEN ERROR "No weight geometry for this vessel."

MACRO Select1
 "%1" | CHECK ifile%1 | "{file%1}" |,
  "Sail":"SAIL","Superstructure":"SAIL","Container":"","Displacer":"HULL","DELETE":DELETE type%1 /WID:12 |,
   partname%1
/
MACRO CheckAll
 SET ifile%1=1 minus {iFile%1}
/
MACRO CheckNegs
 SET ifile%1=0
 SET i=NEXT 0,"@","{file%1}"
 SET s=LEFT {i},"{file%1}"
 SET s=RIGHT 2,"{s}"
 IF "{s}"<>"-@" THEN EXIT
 SET ifile%1=1
 SET type%1="HULL"
/
TEMPLATE Select "Select segments to import" /NOKEY /GAP:2
 "Import as parts" radio imp |,
  "Import as componsnts" radio imp | "of part" bigpartname /tt:"No imbedded blanks, 12 chars max."
 break
 ||| "Type" /cen | "Name" | "  "
 EXPAND Select1 ({nFiles},1) 1
 break
 "Do all" .CheckAll ({nFiles},1) 1 | "Do - only" .CheckNegs ({nFiles},1) 1
/
VARIABLE ifile=0
VARIABLE imp=0
VARIABLE (str) bigpartname
.Select
IF {templok}=0 then end
IF {imp}=0 THEN SET bigpartname=""

MACRO ListFile
 IF {ifile%1}=0 THEN EXIT
 ME {geowts}\{fullname%1}
 ME {type%1}
 ME {partname%1}
/
ME (REPORT) DBWIMP$.TXT
ME {item}
ME {bigpartname}
.ListFile (nFiles,1) 1
ME (REPORT) OFF

ENTER PMX /DIRECT

STR firstGFname:=GFREAD
CARD hashull:=NDISPLACERS
STR path,type,name,item,partname,compname,bigpartname

MACRO DeleteDup
 DELETE %1
/
MACRO CheckForDup
 IF %2[%1]=CAP(name) THEN
   .DeleteDup name
 END
/

MACRO GetParts
 FINPUT() path
 IF path="%EOF%" THEN
  EXIT
 END
 FINPUT() type
 FINPUT() name
 READ {path}
 IF type="HULL" THEN 
  .CheckForDup (NDISPLACERS,1) 0, "DISPLACER"
 ELSIF type="TANK" THEN
  .CheckForDup (NCONTAINERS,1) 0, "CONTAINER"
 ELSIF type="SAIL" THEN
  .CheckForDup (NSAILS,1) 0, "SAIL"
 END
 IF type="DELETE" THEN
  DELETE {PNAME}
  EXIT
 END
 STR PNAME:=DISPLACER[NDISPLACERS-1]
 MACRO X
  PART=%%91
 //
 .X PNAME
 STR CNAME:=COMPONENT[0]
 MACRO MAKENEW
  CREATE %%95\%%93
  CLASS %%94
  SIDE S
  SHAPE %%91\%%92
  ///
  DELETE %%91
  PART OFF
  SURFACE (%%95\%%93)
 //
 IF bigpartname="" THEN
  partname:=name
  compname:=CNAME
 ELSE
  partname:=bigpartname
  compname:=name+".S"
 END
 .MAKENEW PNAME,CNAME,compname,type,partname
 EXIT GetParts
/

FINPUT (OPEN) DBWIMP$.TXT
FINPUT() item
FINPUT() bigpartname
.GetParts
FINPUT (CLOSE)
ERASE "DBWIMP$.TXT"
DISPLAY

TEMPLATE SaveMaybe /size:1.5
 "Save this geometry?" | "Yes" radio skipsave | "No" radio skipsave
/
REAL skipsave:=0
.SaveMaybe
IF templok<>0 THEN
 IF skipsave=0 THEN
  WRITE {firstGFname}
 END
END
QUIT PM